From 9eba16267805e33a2b6d820da238ccb2e0869197 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 28 Feb 2011 11:45:36 +0000
Subject: [PATCH] 1.0.46.16: death to "in: LAMBDA NIL" in compiler messages

 The LAMBDA NIL was 99% of the time the lambda introduced by
 %SIMPLE-EVAL-IN-LEXENV -- in other words totally uninteresting.

 Have EVAL save original form, and use that to name the lambda
 introduced in %SIMPLE-EVAL-IN-LEXENV:

   `(NAMED-LAMBDA (EVAL ,SOURCE-CONTEXT) ...)

 Finally, DEFINE-SOURCE-CONTEXT for NAMED-LAMBDA that understands the
 source context stashed into the name by %SIMPLE-EVAL-IN-LEXENV.

 Additionally, in case there is a legitimate (LAMBDA () ...) form the
 compiler wants to complain about, make sure it is printed as LAMBDA (),
 not LAMBDA NIL.
---
 NEWS                        |    2 ++
 src/code/eval.lisp          |   11 +++++++++--
 src/compiler/ir1report.lisp |    8 +++++++-
 tests/eval.impure.lisp      |    7 +++++++
 version.lisp-expr           |    2 +-
 5 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 628eea2..5bf31b0 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes relative to sbcl-1.0.46:
   * enhancement: redefinition warnings for macros from different files. (lp#434657)
   * enhancement: better MACHINE-VERSION on Darwin x86 and x86-64. (lp#668332)
   * enhancement: (FORMAT "foo" ...) and similar signal a compile-time warning. (lp#327223)
+  * enhancement: no more "in: LAMBDA NIL" messages from the compiler for forms
+    processed using EVAL -- now the appropriate toplevel form is reported instead.
   * optimization: SLOT-VALUE &co are faster in the presence of SLOT-VALUE-USING-CLASS
     and its compatriots.
   * optimization: core startup time is reduced by 30% on x86-64. (lp#557357)
diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index ac9718f..8528a03 100644
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -20,6 +20,8 @@
   (setf sb!eval::*eval-level* -1
         sb!eval::*eval-verbose* nil))
 
+(defvar *eval-source-context* nil)
+
 ;;; general case of EVAL (except in that it can't handle toplevel
 ;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
 (defun %simple-eval (expr lexenv)
@@ -34,7 +36,7 @@
   ;; always safe. --NS
   (let* (;; why PROGN?  So that attempts to eval free declarations
          ;; signal errors rather than return NIL.  -- CSR, 2007-05-01
-         (lambda `(lambda ()
+         (lambda `(named-lambda (eval ,(sb!c::source-form-context *eval-source-context*)) ()
                     (declare (muffle-conditions compiler-note))
                     (progn ,expr)))
          (fun (sb!c:compile-in-lexenv nil lambda lexenv)))
@@ -156,6 +158,10 @@
                            (not (consp (let ((sb!c:*lexenv* lexenv))
                                          (sb!c:lexenv-find name funs)))))
                       (%coerce-name-to-fun name)
+                      ;; FIXME: This is a bit wasteful: it would be nice to call
+                      ;; COMPILE-IN-LEXENV with the lambda-form directly, but
+                      ;; getting consistent source context and muffling compiler notes
+                      ;; is easier this way.
                       (%simple-eval original-exp lexenv))))
                ((quote)
                 (unless (= n-args 1)
@@ -270,7 +276,8 @@
   #!+sb-doc
   "Evaluate the argument in a null lexical environment, returning the
    result or results."
-  (eval-in-lexenv original-exp (make-null-lexenv)))
+  (let ((*eval-source-context* original-exp))
+    (eval-in-lexenv original-exp (make-null-lexenv))))
 
 
 ;;; miscellaneous full function definitions of things which are
diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp
index 25a7f57..a87cd22 100644
--- a/src/compiler/ir1report.lisp
+++ b/src/compiler/ir1report.lisp
@@ -101,6 +101,12 @@
       `(lambda ,(second thing))
       `(function ,thing)))
 
+(define-source-context named-lambda (name lambda-list &body forms)
+  (declare (ignore lambda-list forms))
+  (if (and (consp name) (eq 'eval (first name)))
+      (second name)
+      `(named-lambda ,name)))
+
 ;;; Return the first two elements of FORM if FORM is a list. Take the
 ;;; CAR of the second form if appropriate.
 (defun source-form-context (form)
@@ -296,7 +302,7 @@
                (note-message-repeats stream)
                (setq last nil)
                (pprint-logical-block (stream nil :per-line-prefix "; ")
-                 (format stream "in:~{~<~%    ~4:;~{ ~S~}~>~^ =>~}" in))
+                 (format stream "in:~{~<~%    ~4:;~{ ~:S~}~>~^ =>~}" in))
                (terpri stream))
 
              (unless (and last
diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp
index 6900d74..fc8ec40 100644
--- a/tests/eval.impure.lisp
+++ b/tests/eval.impure.lisp
@@ -256,4 +256,11 @@
     (let ((fun (eval lambda-form)))
       (assert (equal lambda-form (function-lambda-expression fun))))))
 
+(with-test (:name (eval :source-context-in-compiler))
+  (let ((noise (with-output-to-string (*error-output*)
+                 (let ((*evaluator-mode* :compile))
+                   (eval `(defun source-context-test (x) y))))))
+    (with-input-from-string (s noise)
+      (assert (equal "; in: DEFUN SOURCE-CONTEXT-TEST" (read-line s))))))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 7ae9a31..86cef74 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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.46.15"
+"1.0.46.16"
-- 
1.7.10.4