Commit 816d2f40 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

new macro: DOPLIST

 * Like DOLIST, but iterates over plists.
parent 17d45aa8
......@@ -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.")
......
......@@ -43,6 +43,7 @@
#:circular-list
#:circular-list-p
#:circular-tree-p
#:doplist
#:ensure-car
#:ensure-cons
#:ensure-list
......
......@@ -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)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment