[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv3211

Modified Files:
	eval.lisp 
Log Message:
Have macros in the run-time.


--- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp	2007/02/26 18:22:27	1.18
+++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp	2008/03/15 20:57:39	1.19
@@ -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.18 2007/02/26 18:22:27 ffjeld Exp $
+;;;; $Id: eval.lisp,v 1.19 2008/03/15 20:57:39 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -69,46 +69,52 @@
 
 (defun eval-cons (form env)
   "3.1.2.1.2 Conses as Forms"
-  (case (car form)
-    (quote (cadr form))
-    (function (eval-function (second form) env))
-    (when (when (eval-form (second form) env)
-	    (eval-progn (cddr form) env)))
-    (unless (unless (eval-form (second form) env)
-	      (eval-progn (cddr form) env)))
-    (if (if (eval-form (second form) env)
-	    (eval-form (third form) env)
-	  (eval-form (fourth form) env)))
-    (progn (eval-progn (cdr form) env))
-    (prog1 (prog1 (eval-form (cadr form) env)
+  (let ((macro-function (macro-function (car form))))
+    (if macro-function
+	(eval-form (funcall macro-function form nil)
+		   nil)
+	(case (car form)
+	  (quote (cadr form))
+	  (function (eval-function (second form) env))
+	  (when (when (eval-form (second form) env)
+		  (eval-progn (cddr form) env)))
+	  (unless (unless (eval-form (second form) env)
+		    (eval-progn (cddr form) env)))
+	  (if (if (eval-form (second form) env)
+		  (eval-form (third form) env)
+		  (eval-form (fourth form) env)))
+	  (progn (eval-progn (cdr form) env))
+	  (prog1 (prog1 (eval-form (cadr form) env)
+		   (eval-progn (cddr form) env)))
+	  (tagbody (eval-tagbody form env))
+	  (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))
+	  ((lambda) (eval-function form env)) ; the lambda macro..
+	  ((multiple-value-prog1)
+	   (multiple-value-prog1 (eval-form (cadr form) env)
 	     (eval-progn (cddr form) env)))
-    (tagbody (eval-tagbody form env))
-    (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))
-    ((lambda) (eval-function form env)) ; the lambda macro..
-    ((multiple-value-prog1)
-     (multiple-value-prog1 (eval-form (cadr form) env)
-       (eval-progn (cddr form) env)))
-    ((destructuring-bind)
-     (eval-progn (cdddr form)
-      (make-destructuring-env (cadr form)
-			      (eval-form (caddr form) env)
-			      env)))
-    ((catch)
-     (catch (eval-form (second form) env)
-       (eval-progn (cddr form) env)))
-    ((throw)
-     (throw (eval-form (second form) env)
-       (eval-form (third form) env)))
-    ((unwind-protect)
-     (unwind-protect (eval-form (second form) env)
-       (eval-progn (cddr form) env)))
-    (t (eval-funcall form env))))
+	  ((destructuring-bind)
+	   (eval-progn (cdddr form)
+		       (make-destructuring-env (cadr form)
+					       (eval-form (caddr form) env)
+					       env)))
+	  ((catch)
+	   (catch (eval-form (second form) env)
+	     (eval-progn (cddr form) env)))
+	  ((throw)
+	   (throw (eval-form (second form) env)
+	     (eval-form (third form) env)))
+	  ((unwind-protect)
+	   (unwind-protect (eval-form (second form) env)
+	     (eval-progn (cddr form) env)))
+	  ((macrolet symbol-macrolet)
+	   (error "Special operator ~S not implemented in ~S." (car form) 'eval))
+	  (t (eval-funcall form env))))))
 
 (defun eval-progn (forms env)
   (do ((p forms (cdr p)))
@@ -456,5 +462,9 @@
 
 (defun macro-function (symbol &optional environment)
   "=> function"
-  (declare (ignore symbol environment))
-  nil)
+  (when (not (eq nil environment))
+    (error "Unknown environment ~S." environment))
+  (when (fboundp symbol)
+    (let ((f (symbol-function symbol)))
+      (when (typep f 'macro-function)
+	f))))