[cl-utilities-cvs] CVS update: cl-utilities/collecting.lisp

[Peter Scott]

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 @@
 	, at 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 @@
 	, at body)
       (values , at 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