X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=977cd3d74989fd93e92d419d6aa5a44d53291c75;hb=4ba392170e98744f0ef0b8e08a5d42b988f1d0c9;hp=9529f2979dc780808754e8593e316fa1e662e649;hpb=6822034325136cde4e14773c83c3769b42721306;p=sbcl.git diff --git a/src/code/eval.lisp b/src/code/eval.lisp index 9529f29..977cd3d 100644 --- a/src/code/eval.lisp +++ b/src/code/eval.lisp @@ -20,20 +20,44 @@ (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) + +;;;; Turns EXPR into a lambda-form we can pass to COMPILE. Returns +;;;; a secondary value of T if we must call the resulting function +;;;; to evaluate EXPR -- if EXPR is already a lambda form, there's +;;;; no need. +(defun make-eval-lambda (expr) + (if (typep expr `(cons (member lambda named-lambda lambda-with-lexenv))) + (values expr nil) + (values `(lambda () + ;; why PROGN? So that attempts to eval free declarations + ;; signal errors rather than return NIL. -- CSR, 2007-05-01 + (progn ,expr)) + t))) + ;;; general case of EVAL (except in that it can't handle toplevel ;;; EVAL-WHEN magic properly): Delegate to #'COMPILE. (defun %simple-eval (expr lexenv) - ;; FIXME: It might be nice to quieten the toplevel by muffling - ;; warnings generated by this compilation (since we're about to - ;; execute the results irrespective of the warnings). We might want - ;; 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))) - (funcall fun))) + (multiple-value-bind (lambda call) (make-eval-lambda expr) + (let ((fun + ;; This tells the compiler where the lambda comes from, in case it + ;; wants to report any problems. + (let ((sb!c::*source-form-context-alist* + (acons lambda *eval-source-context* + sb!c::*source-form-context-alist*))) + (handler-bind (;; Compiler notes just clutter up the REPL: + ;; anyone caring about performance should not + ;; be using EVAL. + (compiler-note #'muffle-warning)) + (sb!c:compile-in-lexenv + nil lambda lexenv *eval-source-info* *eval-tlf-index* (not call)))))) + (declare (function fun)) + (if call + (funcall fun) + fun)))) ;;; Handle PROGN and implicit PROGN. (defun simple-eval-progn-body (progn-body lexenv) @@ -103,29 +127,17 @@ (declare (optimize (safety 1))) ;; (aver (lexenv-simple-p lexenv)) (incf *eval-calls*) - (handler-bind - ((sb!c:compiler-error - (lambda (c) - (if (boundp 'sb!c::*compiler-error-bailout*) - ;; if we're in the compiler, delegate either to a higher - ;; authority or, if that's us, back down to the - ;; outermost compiler handler... - (progn - (signal c) - nil) - ;; ... if we're not in the compiler, better signal the - ;; error straight away. - (invoke-restart 'sb!c::signal-error))))) + (sb!c:with-compiler-error-resignalling (let ((exp (macroexpand original-exp lexenv))) (handler-bind ((eval-error - (lambda (condition) - (error 'interpreted-program-error - :condition (encapsulated-condition condition) - :form exp)))) + (lambda (condition) + (error 'interpreted-program-error + :condition (encapsulated-condition condition) + :form exp)))) (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 @@ -138,7 +150,7 @@ ;; with DEFINE-SYMBOL-MACRO, keeping the code walkers ;; happy. (:alien - (%simple-eval original-exp lexenv)))) + (sb!alien-internals:alien-value exp)))) (list (let ((name (first exp)) (n-args (1- (length exp)))) @@ -151,6 +163,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) @@ -213,13 +229,13 @@ (destructuring-bind (definitions &rest body) (rest exp) (let ((lexenv - (let ((sb!c:*lexenv* lexenv)) - (sb!c::funcall-in-macrolet-lexenv - definitions - (lambda (&key funs) - (declare (ignore funs)) - sb!c:*lexenv*) - :eval)))) + (let ((sb!c:*lexenv* lexenv)) + (sb!c::funcall-in-macrolet-lexenv + definitions + (lambda (&key funs) + (declare (ignore funs)) + sb!c:*lexenv*) + :eval)))) (simple-eval-locally `(locally ,@body) lexenv)))) ((symbol-macrolet) (destructuring-bind (definitions &rest body) (rest exp) @@ -238,10 +254,7 @@ else) lexenv))) ((let let*) - (destructuring-bind (definitions &rest body) (rest exp) - (if (null definitions) - (simple-eval-locally `(locally ,@body) lexenv) - (%simple-eval exp lexenv)))) + (%simple-eval exp lexenv)) (t (if (and (symbolp name) (eq (info :function :kind name) :function)) @@ -265,8 +278,16 @@ #!+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))) ;;; miscellaneous full function definitions of things which are ;;; ordinarily handled magically by the compiler