From f34fee2b049814e26d32a5b041cb388acdf58814 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 13 Jul 2007 18:57:23 +0000 Subject: [PATCH] 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. --- package-data-list.lisp-expr | 4 ++++ src/code/primordial-extensions.lisp | 14 ++++++++++++-- version.lisp-expr | 2 +- 3 files changed, 17 insertions(+), 3 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 925842f0b..504075911 100644 --- 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 f9293bea9..087968c2d 100644 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -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 diff --git a/version.lisp-expr b/version.lisp-expr index 98cbb2b65..a7c5e7863 100644 --- 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" -- 2.11.4.GIT