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

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) ,@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))
participants (1)
-
pscott@common-lisp.net