Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10797/src/code

Modified Files:
	primordial-extensions.lisp 
Log Message:
1.0.7.18: automagic debugging-friendly gensyms

 * New function: SB-INT:BLOCK-GENSYM, which appends the innermost
   enclosing non-NIL block name to the given stem. The default
   environment used is the current *LEXENV* if one exists.

 * Use it instead of GENSYM in MAKE-GENSYM-LIST and WITH-UNIQUE-NAMES.


Index: primordial-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/primordial-extensions.lisp,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -d -r1.34 -r1.35
--- primordial-extensions.lisp	14 Jul 2005 16:30:37 -0000	1.34
+++ primordial-extensions.lisp	13 Jul 2007 18:57:24 -0000	1.35
@@ -124,6 +124,16 @@
 
 ;;;; GENSYM tricks
 
+;;; GENSYM variant for easier debugging and better backtraces: append
+;;; the closest enclosing non-nil block name to the provided stem.
+(defun block-gensym (&optional (name "G") (env (when (boundp 'sb!c::*lexenv*)
+                                             (symbol-value 'sb!c::*lexenv*))))
+  (let ((block-name (when env
+                      (car (find-if #'car (sb!c::lexenv-blocks env))))))
+    (if block-name
+        (gensym (format nil "~A[~S]" name block-name))
+        (gensym name))))
+
 ;;; Automate an idiom often found in macros:
 ;;;   (LET ((FOO (GENSYM "FOO"))
 ;;;         (MAX-INDEX (GENSYM "MAX-INDEX-")))
@@ -139,7 +149,7 @@
                           (stem (if (every #'alpha-char-p symbol-name)
                                     symbol-name
                                     (concatenate 'string symbol-name "-"))))
-                     `(,symbol (gensym ,stem))))
+                     `(,symbol (block-gensym ,stem))))
                  symbols)
      ,@body))
 
@@ -147,7 +157,7 @@
 ;;; macros and other code-manipulating code.)
 (declaim (ftype (function (index) list) make-gensym-list))
 (defun make-gensym-list (n)
-  (loop repeat n collect (gensym)))
+  (loop repeat n collect (block-gensym)))
 
 ;;;; miscellany

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv10797

Modified Files:
	package-data-list.lisp-expr version.lisp-expr 
Log Message:
1.0.7.18: automagic debugging-friendly gensyms

 * New function: SB-INT:BLOCK-GENSYM, which appends the innermost
   enclosing non-NIL block name to the given stem. The default
   environment used is the current *LEXENV* if one exists.

 * Use it instead of GENSYM in MAKE-GENSYM-LIST and WITH-UNIQUE-NAMES.


Index: package-data-list.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/package-data-list.lisp-expr,v
retrieving revision 1.413
retrieving revision 1.414
diff -u -d -r1.413 -r1.414
--- package-data-list.lisp-expr	30 Jun 2007 09:21:24 -0000	1.413
+++ package-data-list.lisp-expr	13 Jul 2007 18:57:23 -0000	1.414
@@ -801,6 +801,10 @@
                "INFO"
                "MAKE-INFO-ENVIRONMENT"
 
+               ;; GENSYM variant that appends the current non-nil block
+               ;; name to the string if possible
+               "BLOCK-GENSYM"
+
                ;; Constant form evaluation
                "CONSTANT-FORM-VALUE"
                "CONSTANT-TYPEP"

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.3502
retrieving revision 1.3503
diff -u -d -r1.3502 -r1.3503
--- version.lisp-expr	12 Jul 2007 23:05:17 -0000	1.3502
+++ version.lisp-expr	13 Jul 2007 18:57:24 -0000	1.3503
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.7.17"
+"1.0.7.18"

After taking Penis Enlarge Patch you will be able to use your dick as a scarf.

http://www.temoste.net/