From 816d2f40ebeeea385b44df3ecc55b4f937cfb4c8 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 17 Feb 2008 09:10:24 +0200
Subject: [PATCH] new macro: DOPLIST

 * Like DOLIST, but iterates over plists.
---
 lists.lisp   | 34 ++++++++++++++++++++++++++++++++++
 package.lisp |  1 +
 tests.lisp   | 11 +++++++++++
 3 files changed, 46 insertions(+)

diff --git a/lists.lisp b/lists.lisp
index 86f42c4..f94666c 100644
--- a/lists.lisp
+++ b/lists.lisp
@@ -17,6 +17,40 @@ property list PLIST in the same order."
         ((endp tail) (nreverse alist))
       (push (cons (car tail) (cadr tail)) alist))))
 
+(defun malformed-plist (plist)
+  (error "Malformed plist: ~S" plist))
+
+(defmacro doplist ((key val plist &optional values) &body body)
+  "Iterates over elements of PLIST. BODY can be preceded by
+declarations, and is like a TAGBODY. RETURN may be used to terminate
+the iteration early. If RETURN is not used, returns VALUES."
+  (multiple-value-bind (forms declarations) (parse-body body)
+    (with-gensyms (tail loop results)
+      `(block nil
+         (flet ((,results ()
+                  (let (,key ,val)
+                    (declare (ignorable ,key ,val))
+                    (return ,values))))
+           (let* ((,tail ,plist)
+                  (,key (if ,tail
+                            (pop ,tail)
+                            (,results)))
+                 (,val (if ,tail
+                           (pop ,tail)
+                           (malformed-plist ',plist))))
+            (declare (ignorable ,key ,val))
+            ,@declarations
+            (tagbody
+               ,loop
+               ,@forms
+               (setf ,key (if ,tail
+                              (pop ,tail)
+                              (,results))
+                     ,val (if ,tail
+                              (pop ,tail)
+                              (malformed-plist ',plist)))
+               (go ,loop))))))))
+
 (define-modify-macro appendf (&rest lists) append
   "Modify-macro for APPEND. Appends LISTS to the place designated by the first
 argument.")
diff --git a/package.lisp b/package.lisp
index b58ac86..2a38088 100644
--- a/package.lisp
+++ b/package.lisp
@@ -43,6 +43,7 @@
    #:circular-list
    #:circular-list-p
    #:circular-tree-p
+   #:doplist
    #:ensure-car
    #:ensure-cons
    #:ensure-list
diff --git a/tests.lisp b/tests.lisp
index cd918ed..e785d50 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1399,3 +1399,14 @@
                       (values 2 2 2))
       (= a b c 2))
   t)
+
+(deftest doplist.1
+    (let (keys values)
+      (doplist (k v '(a 1 b 2 c 3) (values t (reverse keys) (reverse values) k v))
+        (push k keys)
+        (push v values)))
+  t
+  (a b c)
+  (1 2 3)
+  nil
+  nil)
-- 
2.11.4.GIT