summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-15 01:34:42 +0200
committerMatthias Andreas Benkard <code@mail.matthias.benkard.de>2013-07-15 01:34:42 +0200
commit0d5bbcb4cbf1b8e2d75f4712195120c540515145 (patch)
tree6e50fe7abfdd01f3a202a910bd6984e18e00448b
parent8d7088f386b8ad39ae428692a2ea03ed5faa490e (diff)
LET: Don't confuse binding context with enclosing context wrt. the stack.
-rw-r--r--sb-eval2.lisp34
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*)))