From 9bcced17cb994c42f240d4dc6eff98501fc10251 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Wed, 29 Jun 2022 13:37:59 -0500 Subject: [modify] with-plists to be more useful --- hyperquirks.lisp | 43 +++++++++---------------------------------- 1 file 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." -- cgit v1.2.3