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.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 925842f..5040759 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -801,6 +801,10 @@ possibly temporariliy, because it might be used internally."
                "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"

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index f9293be..087968c 100644 (file)
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -124,6 +124,16 @@
 \f
 ;;;; 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)))
 \f
 ;;;; miscellany
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 98cbb2b..a7c5e78 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"