Paste number 28882: collecting similar to loop/iter collecting

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:
Raw Source | XML | Display As

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

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.