[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-serv20384

Modified Files:
	eval.lisp 
Log Message:
Added defvar as a special-operator. ..Why not?

Date: Thu Apr  1 15:25:07 2004
Author: ffjeld

Index: movitz/losp/muerte/eval.lisp
diff -u movitz/losp/muerte/eval.lisp:1.4 movitz/losp/muerte/eval.lisp:1.5
--- movitz/losp/muerte/eval.lisp:1.4	Thu Apr  1 11:07:37 2004
+++ movitz/losp/muerte/eval.lisp	Thu Apr  1 15:25:07 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.4 2004/04/01 16:07:37 ffjeld Exp $
+;;;; $Id: eval.lisp,v 1.5 2004/04/01 20:25:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -54,6 +54,19 @@
       (or (and binding (cdr binding))
 	  (symbol-value form)))))
 
+;;;  block      let*                  return-from      
+;;;  catch      load-time-value       setq             
+;;;  eval-when  locally               symbol-macrolet  
+;;;  flet       macrolet              tagbody          
+;;;  function   multiple-value-call   the              
+;;;  go         multiple-value-prog1  throw            
+;;;  if         progn                 unwind-protect   
+;;;  labels     progv                                  
+;;;  let        quote                                  
+;;;
+;;;Figure 3-2. Common Lisp Special Operators
+
+
 (defun eval-cons (form env)
   "3.1.2.1.2 Conses as Forms"
   (case (car form)
@@ -69,6 +82,7 @@
     (go (eval-go form env))
     (setq (eval-setq form env))
     (setf (eval-setf form env))
+    ((defvar) (eval-defvar form env))
     (let (eval-let (cadr form) (cddr form) env))
     (time (eval-time (cadr form) env))
     ((defun) (eval-defun (cadr form) (caddr form) (cdddr form) env))
@@ -389,6 +403,15 @@
 		   (eval-form value-form env)
 		   place-subvalues)))))))
 
+(defun eval-defvar (form env)
+  (let ((name (second form)))
+    (check-type name symbol "variable name")
+    (setf (symbol-special-variable-p name) t)
+    (when (and (cddr form) (not (boundp name)))
+      (setf (symbol-value name)
+	(eval-form (third form) env)))
+    name))
+
 (defun compile (name &optional definition)
   "=> function, warnings-p, failure-p"
   (let ((function (eval (or definition (symbol-function name)))))
@@ -397,4 +420,5 @@
     (values (if (not name)
 		function
 	      (setf (symbol-function name) function))
-	    t nil)))
\ No newline at end of file
+	    t nil)))
+