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