fix another LET*/:interpret bug
authorChristophe Rhodes <csr21@cantab.net>
Thu, 14 Nov 2013 17:36:21 +0000 (17:36 +0000)
committerChristophe Rhodes <csr21@cantab.net>
Fri, 15 Nov 2013 09:28:22 +0000 (09:28 +0000)
reported by Douglas Katzman sbcl-devel 2013-09-08

src/code/full-eval.lisp
tests/full-eval.impure.lisp

index 343b138..08f8cb6 100644 (file)
            ;; due to function calls.  (see PARSE-ARGUMENTS)
            (if (and (consp exp) (eq (car exp) 'quote))
                (second exp)
-               (%eval exp env)))
-         (maybe-new-env (env exp)
-           (if (and (consp exp) (eq (car exp) 'quote))
-               env
-               (make-env :parent env))))
+               (%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)
+                (push-var binding-name *special* new-env)
                 (eval-next-let*-binding
-                 (cdr bindings) specials
-                 (maybe-new-env env binding-value) end-action))
+                 (cdr bindings) specials new-env end-action))
               (progn
-                (push-var binding-name (maybe-eval binding-value) env)
+                (push-var binding-name (maybe-eval binding-value) new-env)
                 (eval-next-let*-binding
-                 (cdr bindings) specials
-                 (maybe-new-env env binding-value) end-action))))
+                 (cdr bindings) specials new-env end-action))))
         (funcall end-action env))))
 
 ;;; Create a new environment based on OLD-ENV by adding the variable
index 54a9151..540e6de 100644 (file)
@@ -99,3 +99,8 @@
            (x (progn (funcall *stash* :after-binding-z) 'new-x)))
       (funcall *stash* :in-body)
       (values))))
+
+(with-test (:name (let* :nested-environment-again))
+  (let* ((foo 3)
+         (foo (lambda () (typep foo 'integer))))
+    (assert (funcall foo))))