Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

UTILS: Renaming WITH-UNIQUE-NAMES => WITH-GENSYMS

  • Loading branch information...
commit 962197d6c53de4d70cd1a1bd2633d602ba317581 1 parent 6c7fa3e
@adlai authored
Showing with 10 additions and 23 deletions.
  1. +2 −2 src/check.lisp
  2. +1 −1  src/random.lisp
  3. +7 −20 src/utils.lisp
View
4 src/check.lisp
@@ -100,7 +100,7 @@ REASON-ARGS is provided, is generated based on the form of TEST:
string."
(assert (listp test) (test) "Argument to IS must be a list, not ~S" test)
(let (bindings effective-test default-reason-args)
- (with-unique-names (e a v)
+ (with-gensyms (e a v)
(flet ((process-entry (predicate expected actual &optional negatedp)
;; make sure EXPECTED is holding the entry that starts with 'values
(when (and (consp actual) (eq (car actual) 'values))
@@ -180,7 +180,7 @@ REASON-ARGS is provided, is generated based on the form of TEST:
failure otherwise. Like IS-TRUE, and unlike IS, IS-FALSE does
not inspect CONDITION to determine what reason to give it case
of test failure"
- (with-unique-names (value)
+ (with-gensyms (value)
`(let ((,value ,condition))
(if ,value
(process-failure
View
2  src/random.lisp
@@ -44,7 +44,7 @@ Examples:
(for-all (((a b) (gen-two-integers)))
(is (integerp a))
(is (integerp b)))"
- (with-unique-names (test-lambda-args)
+ (with-gensyms (test-lambda-args)
`(perform-random-testing
(list ,@(mapcar #'second bindings))
(lambda (,test-lambda-args)
View
27 src/utils.lisp
@@ -47,31 +47,18 @@
,(parallel-lookup place ',places ',end-names))))
,@body))))
-;;; This is taken from Arnesi's src/one-liners.lisp, and implements a
-;;; more sophisticated version of PCL's WITH-GENSYMS.
+(defmacro with-gensyms ((&rest syms) &body body)
+ "This is a simple WITH-GENSYMS, similar to the one presented in PCL."
+ `(let ,(mapcar (fn `(,_ (gensym ,(string _)))) syms) ,@body))
-(defmacro with-unique-names ((&rest bindings) &body body)
- ;; reference implementation posted to comp.lang.lisp as
- ;; <cy3bshuf30f.fsf@ljosa.com> by Vebjorn Ljosa - see also
- ;; <http://www.cliki.net/Common%20Lisp%20Utilities>
- `(let ,(mapcar (lambda (binding)
- (check-type binding (or cons symbol))
- (destructuring-bind (var &optional (prefix (symbol-name var)))
- (if (consp binding) binding (list binding))
- (check-type var symbol)
- `(,var (gensym ,(concatenate 'string prefix "-")))))
- bindings)
- ,@body))
-
-;;; This is taken from Arnesi's src/list.lisp, and implements a naive
-;;; list matching facility.
+;;; This is based on from Arnesi's src/list.lisp, and implements a naive ;;; list matching facility.
;;; Marco Baringer says in the original:
;;; ;;;; ** Simple list matching based on code from Paul Graham's On Lisp.
(defmacro acond2 (&rest clauses)
(if (null clauses)
nil
- (with-unique-names (val foundp)
+ (with-gensyms (val foundp)
(destructuring-bind ((test &rest progn) &rest others)
clauses
`(multiple-value-bind (,val ,foundp)
@@ -121,7 +108,7 @@
(if clauses
(destructuring-bind ((test &rest progn) &rest others)
clauses
- (with-unique-names (tgt binds success)
+ (with-gensyms (tgt binds success)
`(let ((,tgt ,target))
(multiple-value-bind (,binds ,success)
(list-match ,tgt ',test)
@@ -133,4 +120,4 @@
(declare (ignorable ,@(vars test)))
,@progn)
(list-match-case ,tgt ,@others))))))
- nil))
+ nil))
Please sign in to comment.
Something went wrong with that request. Please try again.