;;; -*-lisp-*-
;;;
-;;; $Id$
-;;;
;;; Collecting things into lists
;;;
;;; (c) 2005 Straylight/Edgeware
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
-;;;
+;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
-;;;
+;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
(defpackage #:collect
- (:use #:common-lisp #:mdw.base)
- (:export #:collecting #:with-collection #:collect #:collect-tail))
+ (:use #:common-lisp #:mdw.base))
(in-package collect)
(eval-when (:compile-toplevel :load-toplevel)
(defvar *collecting-anon-list-name* (gensym)
- "The default name for anonymous `collecting' lists.")
- (defun make-collector ()
- (let ((head (cons nil nil)))
- (setf (car head) head))))
+ "The default name for anonymous `collecting' lists."))
+
+(export 'make-collector)
+(defun make-collector (&optional list)
+ "Return a new collector object whose initial contents is LIST. Note that
+ LIST will be destroyed if anything else is collected."
+ (let ((head (cons nil list)))
+ (setf (car head) (if list (last list) head))))
+
+(export 'collected)
+(defmacro collected (&optional (name *collecting-anon-list-name*))
+ "Return the current list collected into the collector NAME (or
+ *collecting-anon-list-name* by default)."
+ `(the list (cdr ,name)))
+(export 'collecting)
(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
+ 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
- (values ,@(mapcar (lambda (v) `(the list (cdr ,v))) vars))))
+ (values ,@(mapcar (lambda (v) `(collected ,v)) vars))))
+(export 'with-collection)
(defmacro with-collection (vars collection &body body)
"Collect items into lists VARS according to the form COLLECTION; then
evaluate BODY with VARS bound to those lists."
`(multiple-value-bind
- ,(listify vars)
+ ,(listify vars)
(collecting ,vars ,collection)
,@body))
+(export 'collect)
(defmacro collect (x &optional (name *collecting-anon-list-name*))
"Add item X to the `collecting' list NAME (or *collecting-anon-list-name*
by default)."
(setf (cdar ,name) ,new)
(setf (car ,name) ,new))))
+(export 'collect-tail)
(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
(setf (cdar ,name) ,x)
(setf (car ,name) nil)))
+(export 'collect-append)
(defmacro collect-append (list &optional (name *collecting-anon-list-name*))
"Append LIST to the tail of `collecting' list NAME. This obviously
involves copying LIST."
`(dolist (,item ,list)
(collect ,item ,name))))
+(export 'collect-nconc)
(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."
~mdw / lisp / blobdiff