;;; along with this program; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; along with this program; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(eval-when (:compile-toplevel :load-toplevel)
(defvar *collecting-anon-list-name* (gensym)
"The default name for anonymous `collecting' lists.")
(defun make-collector ()
(eval-when (:compile-toplevel :load-toplevel)
(defvar *collecting-anon-list-name* (gensym)
"The default name for anonymous `collecting' lists.")
(defun make-collector ()
(defmacro collecting (vars &body body)
"Collect items into lists. The VARS are a list of collection variables --
(defmacro collecting (vars &body body)
"Collect items into lists. The VARS are a list of collection variables --
-their values are unspecified, except that they may be passed to `collect' and
-`collect-tail' If VARS is empty then *collecting-anon-list-name* is used.
-VARS may be an atom instead of a singleton list. The form produces multiple
-values, one for each list constructed."
+ their values are unspecified, except that they may be passed to `collect'
+ and `collect-tail' If VARS is empty then *collecting-anon-list-name* is
+ used. VARS may be an atom instead of a singleton list. The form produces
+ multiple values, one for each list constructed."
(cond ((null vars) (setf vars (list *collecting-anon-list-name*)))
((atom vars) (setf vars (list vars))))
`(let ,(mapcar (lambda (v) `(,v (make-collector))) vars)
,@body
(cond ((null vars) (setf vars (list *collecting-anon-list-name*)))
((atom vars) (setf vars (list vars))))
`(let ,(mapcar (lambda (v) `(,v (make-collector))) vars)
,@body
(defmacro with-collection (vars collection &body body)
"Collect items into lists VARS according to the form COLLECTION; then
(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*
(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))))
+ by default)."
+ (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
(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."
+ *collecting-anon-list-name* by default). It is an error to continue
+ trying to add stuff to the list."