summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hyperquirks.lisp43
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."