[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp

[Frode Vatvedt Fjeld]

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 at 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)