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

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index 8528a03..dc74c2c 100644
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -22,6 +22,35 @@
 
 (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)
@@ -34,12 +63,9 @@
   ;;
   ;; As of 1.0.21.6 we muffle compiler notes lexically here, which seems
   ;; always safe. --NS
-  (let* (;; why PROGN?  So that attempts to eval free declarations
-         ;; signal errors rather than return NIL.  -- CSR, 2007-05-01
-         (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)))
+  (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.
@@ -249,10 +275,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))
@@ -276,9 +299,16 @@
   #!+sb-doc
   "Evaluate the argument in a null lexical environment, returning the
    result or results."
-  (let ((*eval-source-context* original-exp))
+  (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