X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Feval.lisp;h=cafbb1cb88451c09805c665f7ee8461513d495cb;hb=d720bc359f03734ccb9baf66cb45dc01d623f369;hp=4687ebd12b7b34e0ad36be5d1fdefccd6866bada;hpb=a80a02aec71e15e1ae7bebd502399ab2b824d08b;p=sbcl.git

diff --git a/src/code/eval.lisp b/src/code/eval.lisp
index 4687ebd..cafbb1c 100644
--- a/src/code/eval.lisp
+++ b/src/code/eval.lisp
@@ -25,48 +25,39 @@
 (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)
-  `(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))
+  (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
-  ;;
-  ;; 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)))
+  (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)
@@ -171,7 +162,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))))
@@ -275,10 +266,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))