;;; 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))
+ (:export #:make-collector #:collected
+ #:collecting #:with-collection
+ #:collect #:collect-tail
+ #:collect-append #:collect-nconc))
(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."))
+
+(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))))
+
+(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)))
(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) `(the list (cdr ,v))) vars))))
+ (values ,@(mapcar (lambda (v) `(collected ,v)) vars))))
(defmacro with-collection (vars collection &body body)
"Collect items into lists VARS according to the form COLLECTION; then