Plaster
New
List
Login
common-lisp
default
anonymous
2021.11.30 13:34:41
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Code (define-symbol-macro %true-flags% ()) (defmacro flag-lambda ((&rest flags) &body body &environment env) (if (null flags) `(lambda () ,@body) (destructuring-bind (flag . other-flags) flags (let ((true-flags (macroexpand-1 '%true-flags% env))) `(if ,flag (symbol-macrolet ((%true-flags% (,flag . ,true-flags))) (flag-lambda (,@other-flags) ,@body)) (flag-lambda (,@other-flags) ,@body)))))) (defmacro flag-when (flag &body body &environment env) (let ((true-flags (macroexpand-1 '%true-flags% env))) (if (member flag true-flags) `(locally ,@body) `(progn)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Example macroexpansion (flag-lambda (x) (flag-when x (print "flagged X")) 42) (IF X (SYMBOL-MACROLET ((%TRUE-FLAGS% (X))) (LAMBDA () (LOCALLY (PRINT "flagged X")) 42)) (LAMBDA () (PROGN) 42)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REPL examples CL-USER> (let ((x t)) (funcall (flag-lambda (x) (flag-when x (print "flagged X")) 42))) "flagged X" 42 CL-USER> (let ((x nil)) (funcall (flag-lambda (x) (flag-when x (print "flagged X")) 42))) 42
Raw
Annotate
Repaste
Edit