Paste number 28882: | collecting similar to loop/iter collecting |
Pasted by: | attila_lendvai |
When: | 18 years, 4 months ago |
Share: | Tweet this! | http://paste.lisp.org/+MAA |
Channel: | #lisp |
Paste contents: |
;; doesn't need the nreverse at the end of push'ing
(defmacro collecting (bindings &body body)
"Similar to collecting in loop, iter and the less efficient but widely used push/nreverse method.
Example:
(collecting (foo bar)
(collect 11 :into foo)
(collect 22 :into bar)
(collect 33 :into foo)
(collect 44 :into bar)
bar)
=>
(22 44)
(collecting ()
(collect 11)
(collect 22)
(collect 33))
=>
; No value"
`(%collecting () ,bindings ,@body))
(defmacro collecting* (bindings &body body)
"Just like collecting, but returns (values ,@collected-lists) when exiting normally.
Example:
(collecting* (foo bar)
(collect 11 :into foo)
(collect 22 :into bar)
(collect 33 :into foo)
(collect 44 :into bar)
bar) ; note the ignored return value
=>
(11 33)
(22 44)
(collecting* ()
(collect 11)
(collect 22)
(collect 33))
=>
(11 22 33)"
`(%collecting (:implicit-return t) ,bindings ,@body))
(defmacro %collecting ((&key implicit-return) bindings &body body)
(unless bindings
(setf bindings (list (gensym))))
(let* ((names (mapcar (lambda (binding)
(if (consp binding)
(first binding)
binding))
bindings))
(tails (mapcar (lambda (name)
(gensym (concatenate 'string (string name) "-TAIL")))
names))
(single-mode-p (= (length names) 1)))
(multiple-value-bind (remaining-forms declarations)
(parse-body body)
`(macrolet ((collect (what &key (into ',(when single-mode-p (first names))))
(if into
(case into
,@(loop for name :in names
for tail :in tails
collect `(',name `(progn
(if ,',tail
(setf (cdr ,',tail) (cons ,what nil)
,',tail (cdr ,',tail))
(setf ,',tail (cons ,what nil)
,',name ,',tail))
(values))))
(t (error "Collect form into unknown variable ~A" into)))
(error "You must specify where to collect into when using multiple places"))))
(let (,@bindings
,@tails)
,declarations
,@remaining-forms
,@(when implicit-return
(if single-mode-p
(list (first names))
`((values ,@names)))))))))
This paste has no annotations.