Add: with-alist

2 files changed, 45 insertions, 1 deletions

diff --git a/derrida.lisp b/derrida.lisp
index ce1abeb..f8fe8bd 100644
--- a/derrida.lisp
+++ b/derrida.lisp
@@ -2,6 +2,49 @@
 
 (in-package #:derrida)
 
+
+
+(defmacro with-alist ((&optional (accessor 'cdr)) (&rest bindings) alist &body body)
+  "Bind variables to accessors into ALISTS. Each member of BINDINGS is
+  either a symbol variable or a list that looks like (var key-term . kwargs).
+
+  The kwargs are passed as keyword argments to (ASSOC KEY-TERM ALIST ...).
+
+EXAMPLE:
+
+  (let ((al 
+          (list (cons 'name \"colin\")
+                (list :hobbies \"fiddling\" \"diddling\")
+                (list \"job\" :executive \"crum bum\"))))
+    (with-alist () 
+        (name (hobbies :hobbies) (job \"job\" :test 'equalp)) 
+        al 
+      (setf job (format nil \"~{~a~^ ~}\" job))
+      (format t \"---------------------------~%\")
+      (format t \"name: ~a~%hobbies: ~{~a~^,~}~%job: ~a~%\" 
+              name hobbies job) 
+      (format t \"---------------------------~%\")
+      al))
+---------------------------
+name: colin
+hobbies: fiddling,diddling
+job: EXECUTIVE crum bum
+---------------------------
+
+((NAME . \"colin\") (:HOBBIES \"fiddling\" \"diddling\")
+ (\"job\" . \"EXECUTIVE crum bum\"))
+"
+  (let* ((alist-var
+           (gensym))
+         (macrolet-bindings
+           (loop for term in bindings
+                 when (symbolp term )
+                   collect `(,term (,accessor (assoc ',term ,alist-var)))
+                 when (consp term)
+                   collect `(,(first term)
+                             (,accessor (assoc ',(second term) ,alist-var ,@(nthcdr 2 term)))))))
+    `(let ((,alist-var ,alist)) (symbol-macrolet ,macrolet-bindings ,@body))))
+
 (defmacro with-plist (keys plist &body body)
   "KEYS is a list, each member of which is either a symbol or a pair of symbols.
 
diff --git a/package.lisp b/package.lisp
index 33d3860..62377cb 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,4 +2,5 @@
 
 (defpackage #:derrida
   (:use #:cl)
-  (:export #:with-plist))
+  (:export #:with-plist
+           #:with-alist))