diff options
| -rw-r--r-- | hyperquirks.lisp | 43 |
1 files changed, 9 insertions, 34 deletions
diff --git a/hyperquirks.lisp b/hyperquirks.lisp index 408a47b..4f88d23 100644 --- a/hyperquirks.lisp +++ b/hyperquirks.lisp @@ -129,42 +129,17 @@ Otherwise 12 would be returned." collect `(when (and ,@vars) (return (progn ,@body)))))) `(imperative ,@imperative-body))) - - -(defmacro with-plist (vars plist &body body) - "Extract some properties from a property list, bind them to a variable -with the same name as the property, and execute the body. - -PLIST is any expression that evaluates to a propety list. - -E.g. - -(let ((me (list :name \"colin\" 'age 40 :occupation :slacker))) - (with-plist ((my-name name) age occupation) me - (format t \"My name is ~a, and I am a ~a year old ~a~%\" - my-name age occupation))) - -Will print out: -My name is colin, and I am a 40 year old SLACKER - -Notice that the keys in the PLIST can be eitehr keywords or symbols in -some other package. -" +(defmacro with-plist (keys plist &body body) (let* ((plist-var (gensym)) - (bindings - (loop for var in vars - when (consp var) - collect `(,(first var) - (or (getf ,plist-var ,(intern (symbol-name (second var)) 'keyword)) - (getf ,plist-var ',var))) - else - collect `(,var (or (getf ,plist-var ,(intern (symbol-name var) 'keyword)) - (getf ,plist-var ',var)))))) - `(let ((,plist-var ,plist)) - (let ,bindings - ,@body)))) - + (macrolet-bindings + (loop for term in keys + when (consp term ) + collect (destructuring-bind (var key) term + `(,var (getf ,plist-var ',key))) + else + collect `(,term (getf ,plist-var ',term))))) + `(let ((,plist-var ,plist)) (symbol-macrolet ,macrolet-bindings ,@body)))) (defmacro with-leaves (leaf-var tree &body body) "Binds each atom in TREE to LEAF-VAR and then executes BODY." |