X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=8528a037844b3a1140f39d842f78d0a6a5993687;hb=eaec8176060e89efa39f01017df1f6204e491ecc;hp=f639dd752cd2940012c86496fde3af978421a7e4;hpb=b3fc19fd2ee925f1a16e301012094b58c2cfd68a;p=sbcl.git

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index f639dd7..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)))
@@ -130,7 +132,7 @@
         (typecase exp
           (symbol
            (ecase (info :variable :kind exp)
-             ((:special :global :constant)
+             ((:special :global :constant :unknown)
               (symbol-value exp))
              ;; FIXME: This special case here is a symptom of non-ANSI
              ;; weirdness in SBCL's ALIEN implementation, which could
@@ -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