1.0.44.25: don't put function leaves into the source-path when a name is available

 #<SB-C::DEFINED-FUN ...> in compiler notes is a bit hard to read, not
 to mention obscure.

diff --git a/NEWS b/NEWS
index 46c0f5c..838c9ad 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -17,6 +17,8 @@ changes relative to sbcl-1.0.44:
   * bug fix: closure VALUE-CELLs are no longer stack-allocated (lp#308934).
   * bug fix: non-standard MAKE-METHOD-LAMBDA methods could break RETURN-FROM
     in the DEFMETHOD body.
+  * bug fix: #<SB-C::DEFINED-FUN ...> should no longer appear in compiler
+    messages, being instead replaced with the corresponding function name.
 
 changes in sbcl-1.0.44 relative to sbcl-1.0.43:
   * enhancement: RUN-PROGRAM accepts :EXTERNAL-FORMAT argument to select the

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 6a8bede..1dff082 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -43,6 +43,18 @@
   (when (source-form-has-path-p form)
     (gethash form *source-paths*)))
 
+(defun simplify-source-path-form (form)
+  (if (consp form)
+      (let ((op (car form)))
+        ;; In the compiler functions can be directly represented
+        ;; by leaves. Having leaves in the source path is pretty
+        ;; hard on the poor user, however, so replace with the
+        ;; source-name when possible.
+        (if (and (leaf-p op) (leaf-has-source-name-p op))
+            (cons (leaf-source-name op) (cdr form))
+            form))
+      form))
+
 (defun note-source-path (form &rest arguments)
   (when (source-form-has-path-p form)
     (setf (gethash form *source-paths*)
@@ -551,7 +563,8 @@
   (defun ir1-convert (start next result form)
     (ir1-error-bailout (start next result form)
       (let* ((*current-path* (or (get-source-path form)
-                                 (cons form *current-path*)))
+                                 (cons (simplify-source-path-form form)
+                                       *current-path*)))
              (start (instrument-coverage start nil form)))
         (cond ((atom form)
                (cond ((and (symbolp form) (not (keywordp form)))

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 1e747c4..afabf80 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1212,6 +1212,21 @@
                       (assert (every #'~= (apply #'concatenate 'list nodes) '(2 3 6 9)))))))
     (sb-ext:timeout ()
       (error "Hang in ORDER-UVL-SETS?"))))
+
+(declaim (inline inlined-function-in-source-path))
+(defun inlined-function-in-source-path (x)
+  (+ x x))
+
+(with-test (:name :inlined-function-in-source-path)
+  (let ((output
+         (with-output-to-string (*error-output*)
+           (compile nil `(lambda (x)
+                           (declare (optimize speed))
+                           (funcall #'inlined-function-in-source-path x))))))
+    ;; We want the name
+    (assert (search "INLINED-FUNCTION-IN-SOURCE-PATH" output))
+    ;; ...not the leaf.
+    (assert (not (search "DEFINED-FUN" output)))))
 \f
 ;;;; tests not in the problem domain, but of the consistency of the
 ;;;; compiler machinery itself

diff --git a/version.lisp-expr b/version.lisp-expr
index abfe3fa..7d8990c 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.44.24"
+"1.0.44.25"