Skip to content

Instantly share code, notes, and snippets.

@guicho271828
Created March 5, 2014 04:27
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save guicho271828/9361168 to your computer and use it in GitHub Desktop.
Save guicho271828/9361168 to your computer and use it in GitHub Desktop.
使えるマクロ: シェル引数を変数にバインド ref: http://qiita.com/guicho271828/items/c050fd5c6375c8e502c3
(defmacro with-boolean-options (bindings before after &body body)
(assert (typep before 'symbol))
(assert (typep after 'symbol))
`(let ((,after ,before))
(let ,(mapcar
(lambda (bind)
(ematch bind
((list (and var (type symbol))
(and str (type string)))
`(,var
(prog1
(if (member ,str ,after :test #'string=) t nil)
(setf ,after (remove ,str ,after :test #'string=)))))))
bindings)
,@body)))
(defun main ()
(print sb-ext:*posix-argv*)
(match sb-ext:*posix-argv*
((list* _ rest)
(with-boolean-options ((*invert* "--invert")
(*ignore-first* "--ignore-first")
(*block* "--block")) rest rest
(apply #'output-to-csv rest)))))
;;;; 展開結果
(LET ((REST REST))
(LET ((*INVERT*
(PROG1
(IF (MEMBER "--invert" REST :TEST #'STRING=)
T
NIL)
(SETF REST (REMOVE "--invert" REST :TEST #'STRING=))))
(*IGNORE-FIRST*
(PROG1
(IF (MEMBER "--ignore-first" REST :TEST #'STRING=)
T
NIL)
(SETF REST (REMOVE "--ignore-first" REST :TEST #'STRING=))))
(*BLOCK*
(PROG1
(IF (MEMBER "--block" REST :TEST #'STRING=)
T
NIL)
(SETF REST (REMOVE "--block" REST :TEST #'STRING=)))))
(APPLY #'OUTPUT-TO-CSV REST)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment