fix another LET*/:interpret bug
[sbcl.git] / src / code / full-eval.lisp
index 5079abc..08f8cb6 100644 (file)
 ;;; Evaluate LET*-like (sequential) bindings.
 ;;;
 ;;; Given an alist of BINDINGS, evaluate the value form of the first
-;;; binding in ENV, bind the variable to the value in ENV, and then
-;;; evaluate the next binding form. Once all binding forms have been
-;;; handled, END-ACTION is funcalled.
+;;; binding in ENV, generate an augmented environment with a binding
+;;; of the variable to the value in ENV, and then evaluate the next
+;;; binding form. Once all binding forms have been handled, END-ACTION
+;;; is funcalled with the final environment.
 ;;;
 ;;; SPECIALS is a list of variables that have a bound special declaration.
 ;;; These variables (and those that have been declaimed as special) are
                (%eval exp env))))
     (if bindings
         (let* ((binding-name (car (car bindings)))
-               (binding-value (cdr (car bindings))))
+               (binding-value (cdr (car bindings)))
+               (new-env (make-env :parent env)))
           (if (specialp binding-name specials)
               (progv
                   (list binding-name)
                   (list (maybe-eval binding-value))
                 ;; Mark the variable as special in this environment
-                (push-var binding-name *special* env)
-                (eval-next-let*-binding (cdr bindings)
-                                        specials env end-action))
+                (push-var binding-name *special* new-env)
+                (eval-next-let*-binding
+                 (cdr bindings) specials new-env end-action))
               (progn
-                (push-var binding-name (maybe-eval binding-value) env)
-                (eval-next-let*-binding (cdr bindings)
-                                        specials env end-action))))
-        (funcall end-action))))
+                (push-var binding-name (maybe-eval binding-value) new-env)
+                (eval-next-let*-binding
+                 (cdr bindings) specials new-env end-action))))
+        (funcall end-action env))))
 
 ;;; Create a new environment based on OLD-ENV by adding the variable
 ;;; bindings in BINDINGS to it, and call FUNCTION with the new environment
            ;; Then deal with optionals / keywords / etc.
            (eval-next-let*-binding
             let*-like-binding var-specials env
-            #'(lambda ()
+            #'(lambda (env)
                 ;; And now that we have evaluated all the
                 ;; initialization forms for the bindings, add the free
                 ;; special declarations to the environment. To see why
           (t (values (cdr binding) :variable)))
         (case (sb!int:info :variable :kind symbol)
           (:macro (values (macroexpand-1 symbol) :expansion))
-          (:alien (let ((type (sb!int:info :variable :alien-info symbol)))
-                    (values (sb!alien::%heap-alien type)
-                            :variable)))
+          (:alien (values (sb!alien-internals:alien-value symbol) :variable))
           (t (values (symbol-value symbol) :variable))))))
 
 ;;; Retrieve the function/macro binding of the symbol NAME in
 
 ;;; Return true if EXP is a lambda form.
 (defun lambdap (exp)
-  (case (car exp) ((lambda
-                    sb!int:named-lambda
-                    sb!kernel:instance-lambda)
-                   t)))
+  (case (car exp)
+    ((lambda sb!int:named-lambda) t)))
 
 ;;; Split off the declarations (and the docstring, if
 ;;; DOC-STRING-ALLOWED is true) from the actual forms of BODY.
 ;;; in the environment ENV.
 (defun eval-lambda (exp env)
   (case (car exp)
-    ((lambda sb!kernel:instance-lambda)
+    ((lambda)
      (multiple-value-bind (body documentation declarations)
          (parse-lambda-headers (cddr exp) :doc-string-allowed t)
        (make-interpreted-function :lambda-list (second exp)
                              (binding-value binding)))
                    bindings)
            var-specials env
-           #'(lambda ()
+           #'(lambda (env)
                ;; Now that we're done evaluating the bindings, add the
                ;; free special declarations. See also
                ;; CALL-WITH-NEW-ENV-FULL-PARSING.
 (defun eval-in-native-environment (form lexenv)
   (handler-bind
       ((sb!impl::eval-error
-        (lambda (condition)
-          (error 'interpreted-program-error
-                 :condition (sb!int:encapsulated-condition condition)
-                 :form form)))
-       (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)))))
-    (handler-case
-        (let ((env (make-env-from-native-environment lexenv)))
-          (%eval form env))
-      (compiler-environment-too-complex-error (condition)
-        (declare (ignore condition))
-        (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex
-                           :form form :lexenv lexenv)
-        (sb!int:simple-eval-in-lexenv form lexenv)))))
+         (lambda (condition)
+           (error 'interpreted-program-error
+                  :condition (sb!int:encapsulated-condition condition)
+                  :form form))))
+    (sb!c:with-compiler-error-resignalling
+      (handler-case
+          (let ((env (make-env-from-native-environment lexenv)))
+            (%eval form env))
+        (compiler-environment-too-complex-error (condition)
+          (declare (ignore condition))
+          (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex
+                             :form form :lexenv lexenv)
+          (sb!int:simple-eval-in-lexenv form lexenv))))))