Update of /project/cl-utilities/cvsroot/cl-utilities In directory common-lisp.net:/tmp/cvs-serv7621

Modified Files: collecting.lisp Log Message: Refactored, moved things around, improved error handling, and generally improved things.

Date: Thu May 26 22:16:47 2005 Author: pscott

Index: cl-utilities/collecting.lisp diff -u cl-utilities/collecting.lisp:1.1.1.1 cl-utilities/collecting.lisp:1.2 --- cl-utilities/collecting.lisp:1.1.1.1 Mon May 9 23:26:29 2005 +++ cl-utilities/collecting.lisp Thu May 26 22:16:47 2005 @@ -1,5 +1,3 @@ -(in-package :cl-utilities) - ;; Opinions differ on how a collection macro should work. There are ;; two main points for discussion: multiple collection variables and ;; implementation method. @@ -14,11 +12,11 @@ ;; it always uses the COLLECT function. If you want to collect into ;; multiple lists, use the WITH-COLLECT macro.

- +(in-package :cl-utilities)

;; This should only be called inside of COLLECTING macros, but we ;; define it here to provide an informative error message and to make -;; it easier for SLIME (et al) to get documentation for the COLLECT +;; it easier for SLIME (et al.) to get documentation for the COLLECT ;; function when it's used in the COLLECTING macro. (defun collect (thing) "Collect THING in the context established by the COLLECTING macro" @@ -40,27 +38,13 @@ ,@body) ,collector)))

-#+nil -(collecting - (dotimes (x 10) - (collect x))) - -;(collecting (mapc #'collect '(1 2 3 4 5))) - (defmacro with-collectors ((&rest collectors) &body body) "Collect some things into lists forwards. The names in COLLECTORS are defined as local functions which each collect into a separate list. Returns as many values as there are collectors, in the order they were given." - ;; Check that all of the COLLECTORS are symbols. If not, raise an error. - (let ((bad-collector (find-if-not #'symbolp collectors))) - (when bad-collector - (error "WITH-COLLECTORS expected a symbol but got ~S" bad-collector))) - (let ((gensyms-alist (mapcar #'cons collectors - (mapcar #'gensym - (mapcar #'(lambda (x) - (format nil "~A-TAIL-" x)) - collectors))))) + (%with-collectors-check-collectors collectors) + (let ((gensyms-alist (%with-collectors-gensyms-alist collectors))) `(let ,(loop for collector in collectors for tail = (cdr (assoc collector gensyms-alist)) nconc (list collector tail)) @@ -75,10 +59,26 @@ ,@body) (values ,@collectors))))

-#+nil -(with-collectors (one-through-nine abc) - (mapcar #'abc '(a b c)) - (dotimes (x 10) - (one-through-nine x) - (print one-through-nine)) - (terpri) (terpri)) \ No newline at end of file +(defun %with-collectors-check-collectors (collectors) + "Check that all of the COLLECTORS are symbols. If not, raise an error." + (let ((bad-collector (find-if-not #'symbolp collectors))) + (when bad-collector + (error 'type-error + :datum bad-collector + :expected-type 'symbol)))) + +(defun %with-collectors-gensyms-alist (collectors) + "Return an alist mapping the symbols in COLLECTORS to gensyms" + (mapcar #'cons collectors + (mapcar (compose #'gensym + #'(lambda (x) + (format nil "~A-TAIL-" x))) + collectors))) + +;; Some test code which would be too hard to move to the test suite. +#+nil (with-collectors (one-through-nine abc) + (mapcar #'abc '(a b c)) + (dotimes (x 10) + (one-through-nine x) + (print one-through-nine)) + (terpri) (terpri)) \ No newline at end of file