Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15555
Modified Files: eval.lisp Log Message: Fixed interpreted setq and setf to deal with lexical variables, according to Alessio Stalla's bug-report.
Date: Wed Aug 18 13:16:27 2004 Author: ffjeld
Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.9 movitz/losp/muerte/eval.lisp:1.10 --- movitz/losp/muerte/eval.lisp:1.9 Wed Jun 16 00:37:17 2004 +++ movitz/losp/muerte/eval.lisp Wed Aug 18 13:16:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.9 2004/06/16 07:37:17 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.10 2004/08/18 20:16:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -366,28 +366,38 @@ (unless b (error "Go-tag ~S is not visible." tag)) (throw (cdr b) (values tag))))
+(defun eval-set-variable (variable-name value env) + "Perform e.g. (setq <variable-name> <value>) according to <env>. Return <value>." + (check-type variable-name symbol "a variable name") + (if (symbol-special-variable-p variable-name) + (set variable-name value) + (let ((binding (env-binding env variable-name))) + (if binding + (setf (cdr binding) value) + ;; We could emit a warning here, or whatever. + (set variable-name value)))))
(defun eval-setq (form env) (do* ((p (cdr form) (cddr p)) - (value nil)) - ((null p) value) + (final-value nil)) + ((null p) final-value) (assert (cdr p) (form) "Odd number of arguments to setq: ~W" form) - (setf value - (set (car p) (eval-form (cadr p) env))))) + (setf final-value + (eval-set-variable (car p) (eval-form (cadr p) env) env))))
(defun eval-setf (form env) (do* ((p (cdr form) (cddr p)) - (value nil)) - ((null p) value) + (final-value nil)) + ((null p) final-value) (assert (cdr p) (form) "Odd number of arguments to setf: ~W" form) - (setf value + (setf final-value (let ((place (first p)) (value-form (second p))) (if (symbolp place) - (set place (eval-form value-form env)) - ;; eval subvalues before value-form.. + (eval-set-variable place (eval-form value-form env) env) + ;; eval place's subforms before value-form.. (let ((place-subvalues (eval-arglist (cdr place) env))) (apply (lookup-setf-function (caar p)) (eval-form value-form env)