;; 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)))))))))