1.0.48.1: WITH-COMPILATION-UNIT :SOURCE-NAMESTRING

  Allows specifying an alternate namestring to use for debug-source.

  This will help us get redefinition warnings working nicely with C-c C-c in
  Slime.

diff --git a/src/code/source-location.lisp b/src/code/source-location.lisp
index 3d488d2..be1abd2 100644 (file)
--- a/src/code/source-location.lisp
+++ b/src/code/source-location.lisp
@@ -16,10 +16,11 @@
   ;; Namestring of the source file that the definition was compiled from.
   ;; This is null if the definition was not compiled from a file.
   (namestring
-   (when (and (boundp '*source-info*)
-              *source-info*)
-     (make-file-info-namestring *compile-file-pathname*
-                                (sb!c:get-toplevelish-file-info *source-info*)))
+   (or *source-namestring*
+       (when (and (boundp '*source-info*)
+                  *source-info*)
+         (make-file-info-namestring *compile-file-pathname*
+                                    (sb!c:get-toplevelish-file-info *source-info*))))
    :type (or string null))
   ;; Toplevel form index
   (toplevel-form-number

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index f2b5c31..faecc2b 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -256,10 +256,11 @@
     (make-debug-source
      :compiled (source-info-start-time info)
 
-     :namestring (make-file-info-namestring
-                  (if (pathnamep (file-info-name file-info))
-                      (file-info-name file-info))
-                  file-info)
+     :namestring (or *source-namestring*
+                     (make-file-info-namestring
+                      (if (pathnamep (file-info-name file-info))
+                          (file-info-name file-info))
+                      file-info))
      :created (file-info-write-date file-info)
      :source-root (file-info-source-root file-info)
      :start-positions (coerce-to-smallest-eltype

diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index bb883b4..c1715dd 100644 (file)
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -112,6 +112,7 @@
 (defvar *lexenv*)
 (defvar *source-info*)
 (defvar *source-plist*)
+(defvar *source-namestring*)
 (defvar *trace-table*)
 (defvar *undefined-warnings*)
 (defvar *warnings-p*)

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 49b0ef7..c9fc000 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -164,6 +164,19 @@ Following options are defined:
       This option is an SBCL-specific experimental extension: Interface
       subject to change.
 
+  :SOURCE-NAMESTRING Namestring-Form
+      Attaches the value returned by the Namestring-Form to the internal
+      debug-source information as the namestring of the source file. Normally
+      the namestring of the input-file for COMPILE-FILE is used: this option
+      can be used to provide source-file information for functions compiled
+      using COMPILE, or to override the input-file of COMPILE-FILE.
+
+      If both an outer and an inner WITH-COMPILATION-UNIT provide a
+      SOURCE-NAMESTRING, the inner one takes precedence. Unaffected
+      by :OVERRIDE.
+
+      This is an SBCL-specific extension.
+
   :SOURCE-PLIST Plist-Form
       Attaches the value returned by the Plist-Form to internal debug-source
       information of functions compiled in within the dynamic extent of BODY.
@@ -201,12 +214,14 @@ Examples:
   `(%with-compilation-unit (lambda () ,@body) ,@options))
 
 (defvar *source-plist* nil)
+(defvar *source-namestring* nil)
 
-(defun %with-compilation-unit (fn &key override policy source-plist)
+(defun %with-compilation-unit (fn &key override policy source-plist source-namestring)
   (declare (type function fn))
   (flet ((with-it ()
            (let ((succeeded-p nil)
-                 (*source-plist* (append source-plist *source-plist*)))
+                 (*source-plist* (append source-plist *source-plist*))
+                 (*source-namestring* (or source-namestring *source-namestring*)))
              (if (and *in-compilation-unit* (not override))
                  ;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is
                  ;; ordinarily (unless OVERRIDE) basically a no-op.