From: Christophe Rhodes Date: Sun, 3 Nov 2013 16:32:49 +0000 (+0000) Subject: fix LET* environment semantics in sexp-based evaluator X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9c9d6dbdc28a8bfe70be09f35263e9ec02411d0e;p=sbcl.git fix LET* environment semantics in sexp-based evaluator --- diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp index ca43691..343b138 100644 --- a/src/code/full-eval.lisp +++ b/src/code/full-eval.lisp @@ -357,9 +357,10 @@ ;;; 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 @@ -370,7 +371,11 @@ ;; due to function calls. (see PARSE-ARGUMENTS) (if (and (consp exp) (eq (car exp) 'quote)) (second exp) - (%eval exp env)))) + (%eval exp env))) + (maybe-new-env (env exp) + (if (and (consp exp) (eq (car exp) 'quote)) + env + (make-env :parent env)))) (if bindings (let* ((binding-name (car (car bindings))) (binding-value (cdr (car bindings)))) @@ -380,13 +385,15 @@ (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)) + (eval-next-let*-binding + (cdr bindings) specials + (maybe-new-env env binding-value) 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)))) + (eval-next-let*-binding + (cdr bindings) specials + (maybe-new-env env binding-value) 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 @@ -461,7 +468,7 @@ ;; 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 @@ -646,7 +653,7 @@ (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. diff --git a/tests/full-eval.impure.lisp b/tests/full-eval.impure.lisp index b2eb21a..54a9151 100644 --- a/tests/full-eval.impure.lisp +++ b/tests/full-eval.impure.lisp @@ -86,3 +86,16 @@ (let ((sb-ext:*evaluator-mode* :compile)) (load *file*)))) (delete-file *file*) + +(defvar *stash*) +(defun save-it (f) (setq *stash* f) 'whatever) +(with-test (:name (let* :nested-environments)) + (let ((z 'zee) (y 'y) (x 92)) + (let* ((baz (save-it (lambda (what) (assert (equal (list what x y z) + (list what 92 'y 'zee)))))) + (mum (funcall *stash* :after-binding-baz)) + (y 'new-y) + (z (progn (funcall *stash* :after-binding-y) 'new-z)) + (x (progn (funcall *stash* :after-binding-z) 'new-x))) + (funcall *stash* :in-body) + (values))))