ViewVC logotype

Contents of /cl-utilities/with-unique-names.lisp

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.4 - (show annotations)
Thu May 26 20:00:00 2005 UTC (8 years, 10 months ago) by pscott
Branch: MAIN
Changes since 1.3: +13 -9 lines
Refactored and improved type checking.
1 (in-package :cl-utilities)
3 ;; Defined at http://www.cliki.net/WITH-UNIQUE-NAMES
5 (defmacro with-unique-names ((&rest bindings) &body body)
6 "Executes a series of forms with each var bound to a fresh,
7 uninterned symbol. See http://www.cliki.net/WITH-UNIQUE-NAMES"
8 `(let ,(mapcar #'(lambda (binding)
9 (multiple-value-bind (var prefix)
10 (%with-unique-names-binding-parts binding)
11 (check-type var symbol)
12 `(,var (gensym ,(format nil "~A"
13 (or prefix var))))))
14 bindings)
15 ,@body))
17 (defun %with-unique-names-binding-parts (binding)
18 "Return (values var prefix) from a WITH-UNIQUE-NAMES binding
19 form. If PREFIX is not given in the binding, NIL is returned to
20 indicate that the default should be used."
21 (if (consp binding)
22 (values (first binding) (second binding))
23 (values binding nil)))
25 (define-condition list-binding-not-supported (warning)
26 ((binding :initarg :binding :reader list-binding-not-supported-binding))
27 (:report (lambda (condition stream)
28 (format stream "List binding ~S not supported by WITH-GENSYMS.
29 It will work, but you should use WITH-UNIQUE-NAMES instead."
30 (list-binding-not-supported-binding condition))))
31 (:documentation "List bindings aren't supported by WITH-GENSYMS, and
32 if you want to use them you should use WITH-UNIQUE-NAMES instead. That
33 said, they will work; they'll just signal this warning to complain
34 about it."))
37 (defmacro with-gensyms ((&rest bindings) &body body)
38 "Synonym for WITH-UNIQUE-NAMES, but BINDINGS should only consist of
39 atoms; lists are not supported. If you try to give list bindings, a
40 LIST-BINDING-NOT-SUPPORTED warning will be signalled, but it will work
41 the same way as WITH-UNIQUE-NAMES. Don't do it, though."
42 ;; Signal a warning for each list binding, if there are any
43 (dolist (binding (remove-if-not #'listp bindings))
44 (warn 'list-binding-not-supported :binding binding))
45 ;; Otherwise, this is a synonym for WITH-UNIQUE-NAMES
46 `(with-unique-names ,bindings ,@body))

  ViewVC Help
Powered by ViewVC 1.1.5