diff options
| author | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-17 00:09:18 +0200 |
|---|---|---|
| committer | Matthias Andreas Benkard <code@mail.matthias.benkard.de> | 2013-07-17 00:09:18 +0200 |
| commit | 58d3332b0d9344c9546e64765ce0ab301938e2dc (patch) | |
| tree | 5e600fbd2fe848219f0b4a22e50052c58e89f393 | |
| parent | 0282accc82e509b0977843d4022d54f5359437da (diff) | |
LET, LET*: Fix some environment issues.
| -rw-r--r-- | sb-eval2.lisp | 36 |
1 files changed, 14 insertions, 22 deletions
diff --git a/sb-eval2.lisp b/sb-eval2.lisp index 33494c8..2aa98f5 100644 --- a/sb-eval2.lisp +++ b/sb-eval2.lisp @@ -615,7 +615,6 @@ (varnum (length vars)) (envp (or (> varnum +stack-max+) (maybe-closes-over-p `(progn ,@body) vars))) - (n (length (the list bindings))) (new-context (context-add-env-lexicals context (list))) lexical-values* @@ -623,16 +622,17 @@ (loop for (var . value-form) in real-bindings for val* = (prepare-form value-form context) if (globally-special-p var) - collect (cons var val*) into specials + collect (cons var val*) into specials else - collect val* into lexicals - and do (context-add-env-lexical! new-context var) + collect val* into lexicals + and do (context-add-env-lexical! new-context var) finally (setq lexical-values* lexicals special-bindings* specials)) (let ((body* (prepare-progn body new-context)) (special-vars (mapcar #'car special-bindings*)) - (special-vals* (mapcar #'cdr special-bindings*))) + (special-vals* (mapcar #'cdr special-bindings*)) + (n (length (the list lexical-values*)))) (if envp (lambda (env) (let ((new-env (make-environment env n))) @@ -668,54 +668,46 @@ (varnum (length vars)) (envp (or (> varnum +stack-max+) (maybe-closes-over-p `(progn ,@body) vars))) - (n (length (the list bindings))) (new-context (context-add-env-lexicals context (list))) - (values* (loop for (var . value-form) in real-bindings - for val* = (prepare-form value-form new-context) - if (globally-special-p var) - collect (cons var val*) into specials - else - collect val* into lexicals - and do (context-add-env-lexical! context var))) - lexical-values* special-bindings*) (loop for (var . value-form) in real-bindings for val* = (prepare-form value-form new-context) if (globally-special-p var) - collect (cons var val*) into specials + collect (cons var val*) into specials else - collect val* into lexicals - and do (context-add-env-lexical! new-context var) + collect val* into lexicals + and do (context-add-env-lexical! new-context var) finally (setq lexical-values* lexicals special-bindings* specials)) (let ((body* (prepare-progn body new-context)) (special-vars (mapcar #'car special-bindings*)) - (special-vals* (mapcar #'cdr special-bindings*))) + (special-vals* (mapcar #'cdr special-bindings*)) + (n (length (the list lexical-values*)))) (if envp (lambda (env) (let ((new-env (make-environment env n))) (loop for i from 0 below n - for val* in values* + for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) new-env))) (progv special-vars (loop for val* in special-vals* - collect (funcall (the eval-closure val*) env)) + collect (funcall (the eval-closure val*) new-env)) (funcall body* new-env)))) (lambda (env) (with-dynamic-extent-environment (new-env env n) (loop for i from 0 below n - for val* in values* + for val* in lexical-values* do (setf (environment-value new-env 0 i) (funcall (the eval-closure val*) new-env))) (progv special-vars (loop for val* in special-vals* - collect (funcall (the eval-closure val*) env)) + collect (funcall (the eval-closure val*) new-env)) (funcall body* new-env))))))))) ((load-time-value) (let ((load-form (cadr form))) |