[modify] with-plists to be more useful

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."