(defvar *collecting-anon-list-name* (gensym)
"The default name for anonymous `collecting' lists.")
(defun make-collector ()
- (let ((c (cons nil nil)))
- (cons c c))))
+ (let ((head (cons nil nil)))
+ (setf (car head) head))))
(defmacro collecting (vars &body body)
"Collect items into lists. The VARS are a list of collection variables --
((atom vars) (setf vars (list vars))))
`(let ,(mapcar (lambda (v) `(,v (make-collector))) vars)
,@body
- (values ,@(mapcar (lambda (v) `(cdar ,v)) vars))))
+ (values ,@(mapcar (lambda (v) `(the list (cdr ,v))) vars))))
(defmacro with-collection (vars collection &body body)
"Collect items into lists VARS according to the form COLLECTION; then
(defmacro collect (x &optional (name *collecting-anon-list-name*))
"Add item X to the `collecting' list NAME (or *collecting-anon-list-name*
by default)."
- (with-gensyms tmp
- `(let ((,tmp (cons ,x nil)))
- (setf (cddr ,name) ,tmp)
- (setf (cdr ,name) ,tmp))))
+ (with-gensyms new
+ `(let ((,new (cons ,x nil)))
+ (setf (cdar ,name) ,new)
+ (setf (car ,name) ,new))))
(defmacro collect-tail (x &optional (name *collecting-anon-list-name*))
"Make item X be the tail of `collecting' list NAME (or
*collecting-anon-list-name* by default). It is an error to continue
trying to add stuff to the list."
`(progn
- (setf (cddr ,name) ,x)
- (setf (cdr ,name) nil)))
+ (setf (cdar ,name) ,x)
+ (setf (car ,name) nil)))
+
+(defmacro collect-append (list &optional (name *collecting-anon-list-name*))
+ "Append LIST to the tail of `collecting' list NAME. This obviously
+ involves copying LIST."
+ (with-gensyms item
+ `(dolist (,item ,list)
+ (collect ,item ,name))))
+
+(defmacro collect-nconc (list &optional (name *collecting-anon-list-name*))
+ "Attach LIST to the tail of `collecting' list NAME. This will involve
+ destroying LIST if anything else gets collected afterwards."
+ (let*/gensyms list
+ `(when ,list
+ (setf (cdar ,name) ,list)
+ (setf (car ,name) (last ,list)))))
;;;----- That's all, folks --------------------------------------------------