(setf sb!eval::*eval-level* -1
sb!eval::*eval-verbose* nil))
+(defvar *eval-source-context* nil)
+
+(defvar *eval-tlf-index* nil)
+(defvar *eval-source-info* nil)
+
+(defun make-eval-lambda (expr)
+ `(named-lambda
+ ;; This name is used to communicate the original context
+ ;; for the compiler, and identifies the lambda for use of
+ ;; EVAL-LAMBDA-SOURCE-LAMBDA below.
+ (eval ,(sb!c::source-form-context *eval-source-context*)) ()
+ (declare (muffle-conditions compiler-note))
+ ;; why PROGN? So that attempts to eval free declarations
+ ;; signal errors rather than return NIL. -- CSR, 2007-05-01
+ (progn ,expr)))
+
+(defun eval-lambda-p (form)
+ (when (and (consp form) (eq 'named-lambda (first form)))
+ (let ((name (second form)))
+ (when (and (consp name) (eq 'eval (first name)))
+ t))))
+
+(defun eval-lambda-source-lambda (eval-lambda)
+ (if (eval-lambda-p eval-lambda)
+ (destructuring-bind (named-lambda name lambda-list decl (progn expr))
+ eval-lambda
+ (declare (ignore named-lambda name lambda-list decl progn))
+ (when (and (consp expr) (member (car expr) '(lambda named-lambda)))
+ expr))
+ eval-lambda))
+
;;; general case of EVAL (except in that it can't handle toplevel
;;; EVAL-WHEN magic properly): Delegate to #'COMPILE.
(defun %simple-eval (expr lexenv)
;; to be careful about not muffling warnings arising from inner
;; evaluations/compilations, though [e.g. the ignored variable in
;; (DEFUN FOO (X) 1)]. -- CSR, 2003-05-13
- (let* (;; why PROGN? So that attempts to eval free declarations
- ;; signal errors rather than return NIL. -- CSR, 2007-05-01
- (lambda `(lambda () (progn ,expr)))
- (fun (sb!c:compile-in-lexenv nil lambda lexenv)))
+ ;;
+ ;; As of 1.0.21.6 we muffle compiler notes lexically here, which seems
+ ;; always safe. --NS
+ (let* ((lambda (make-eval-lambda expr))
+ (fun (sb!c:compile-in-lexenv
+ nil lambda lexenv *eval-source-info* *eval-tlf-index*)))
(funcall fun)))
;;; Handle PROGN and implicit PROGN.
(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
(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)
#!+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-tlf-index* nil)
+ (*eval-source-info* nil))
+ (eval-in-lexenv original-exp (make-null-lexenv))))
+(defun eval-tlf (original-exp tlf-index &optional (lexenv (make-null-lexenv)))
+ (let ((*eval-source-context* original-exp)
+ (*eval-tlf-index* tlf-index)
+ (*eval-source-info* sb!c::*source-info*))
+ (eval-in-lexenv original-exp lexenv)))
\f
;;; miscellaneous full function definitions of things which are
;;; ordinarily handled magically by the compiler