LET: Don't confuse binding context with enclosing context wrt. the stack.

1 files changed, 24 insertions, 10 deletions

diff --git a/sb-eval2.lisp b/sb-eval2.lisp
index 8982405..055c4b8 100644
--- a/sb-eval2.lisp
+++ b/sb-eval2.lisp
@@ -166,6 +166,12 @@
                            for v in vars
                            collect (make-env-lexical v i))))
     new-context))
+(defun context-bump-stack (context)
+  (let ((new-context (make-context context)))
+    (with-slots (stack-hop)
+        new-context
+      (setq stack-hop t))
+    new-context))
 (defun context-add-stack-lexicals (context vars)
   ;; open a new variable context
     (let ((new-context (make-context context)))
@@ -565,16 +571,24 @@
            ((let)
             ;; FIXME: SPECIAL declarations!
             (destructuring-bind (bindings &rest body) (rest form)
-              (let* ((bindings* (mapcar (lambda (form)
-                                          (if (listp form)
-                                              (cons (first form)
-                                                    (prepare-form (second form) context))
-                                              (cons form (prepare-nil))))
-                                        bindings))
-                     (n (length bindings*))
-                     (values* (mapcar #'cdr bindings*))
-                     (vars (mapcar #'car bindings*)))
-                (if (maybe-closes-over-p `(progn ,@body) vars)
+              (let* ((real-bindings (mapcar (lambda (form)
+                                              (if (listp form)
+                                                  (cons (first form) (second form))
+                                                  (cons form nil)))
+                                            bindings))
+                     (vars (mapcar #'car real-bindings))
+                     (envp (maybe-closes-over-p `(progn ,@body) vars))
+                     (binding-context (if envp
+                                          context
+                                          (context-bump-stack context)))
+                     (bindings* (mapcar (lambda (form)
+                                          (cons (car form)
+                                                (prepare-form (cdr form)
+                                                              binding-context)))
+                                        real-bindings))
+                     (n (length (the list bindings)))
+                     (values* (mapcar #'cdr bindings*)))
+                (if envp
                     (let* ((new-context
                              (context-add-env-lexicals context
                                                        (mapcar #'first bindings*)))