[cl-utilities-cvs] CVS update: cl-utilities/with-unique-names.lisp

[Peter Scott]

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

Modified Files:
	with-unique-names.lisp 
Log Message:
Refactored and improved type checking.

Date: Thu May 26 22:00:00 2005
Author: pscott

Index: cl-utilities/with-unique-names.lisp
diff -u cl-utilities/with-unique-names.lisp:1.3 cl-utilities/with-unique-names.lisp:1.4
--- cl-utilities/with-unique-names.lisp:1.3	Mon May 16 21:12:00 2005
+++ cl-utilities/with-unique-names.lisp	Thu May 26 22:00:00 2005
@@ -6,17 +6,21 @@
   "Executes a series of forms with each var bound to a fresh,
 uninterned symbol. See http://www.cliki.net/WITH-UNIQUE-NAMES"
   `(let ,(mapcar #'(lambda (binding)
-                     (destructuring-bind (var prefix)
-			 (if (consp binding)
-			     binding
-			     (list binding binding))
-		       (if (symbolp var)
-			   `(,var (gensym ,(format nil "~A" prefix)))
-			   (error 'type-error
-				  :datum var
-				  :expected-type 'symbol))))
+                     (multiple-value-bind (var prefix)
+			 (%with-unique-names-binding-parts binding)
+		       (check-type var symbol)
+		       `(,var (gensym ,(format nil "~A"
+					       (or prefix var))))))
                  bindings)
     , at body))
+
+(defun %with-unique-names-binding-parts (binding)
+  "Return (values var prefix) from a WITH-UNIQUE-NAMES binding
+form. If PREFIX is not given in the binding, NIL is returned to
+indicate that the default should be used."
+  (if (consp binding)
+      (values (first binding) (second binding))
+      (values binding nil)))
 
 (define-condition list-binding-not-supported (warning)
   ((binding :initarg :binding :reader list-binding-not-supported-binding))