[movitz-cvs] CVS movitz/losp/muerte

ffjeld ffjeld at common-lisp.net
Sun Mar 16 22:28:07 UTC 2008


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

Modified Files:
	basic-macros.lisp 
Log Message:
Working on making macros work.


--- /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp	2008/03/15 20:57:16	1.71
+++ /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp	2008/03/16 22:28:07	1.72
@@ -9,68 +9,14 @@
 ;;;; Created at:    Wed Nov  8 18:44:57 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: basic-macros.lisp,v 1.71 2008/03/15 20:57:16 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.72 2008/03/16 22:28:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
 (provide :muerte/basic-macros)
 
-;; First of all we must define DEFMACRO..
-(muerte::defmacro-compile-time muerte.cl:defmacro (name lambda-list &body macro-body)
-  (`(muerte.cl:progn
-      (muerte::defmacro-compile-time ,name ,lambda-list ,macro-body)
-      ',name)))
-
-(muerte.cl:defmacro muerte.cl:in-package (name)
-  `(progn
-     (eval-when (:compile-toplevel)
-       (in-package ,(movitz::movitzify-package-name name)))))
-
 (in-package muerte)
 
-(defmacro defmacro/cross-compilation (name lambda-list &body body)
-  `(progn
-     (defmacro-compile-time ,name ,lambda-list ,body)
-     ',name))
-
-(defmacro defmacro (name lambda-list &body body)
-  `(defmacro/cross-compilation ,name ,lambda-list , at body))
-
-(defmacro defmacro/runtime (name lambda-list &body body)
-  (multiple-value-bind (real-body declarations docstring)
-      (movitz::parse-docstring-declarations-and-body body 'cl:declare)
-    (let* ((block-name (compute-function-block-name name))
-	   (ignore-var (gensym))
-	   (form-var (gensym "form-"))
-	   (env-var nil)
-	   (operator-var (gensym))
-	   (destructuring-lambda-list
-	    (do ((l lambda-list)
-		 (r nil))
-		((atom l)
-		 (cons operator-var
-		       (nreconc r l)))
-	      (let ((x (pop l)))
-		(if (eq x '&environment)
-		    (setf env-var (pop l))
-		    (push x r))))))
-      (multiple-value-bind (env-var ignore-env)
-	  (if env-var
-	      (values env-var nil)
-	      (let ((e (gensym)))
-		(values e (list e))))
-	`(make-named-function ,name
-			      (&edx edx &optional ,form-var ,env-var &rest ,ignore-var)
-			      ((ignore ,ignore-var , at ignore-env))
-			      ,docstring
-			      (block ,block-name
-				(verify-macroexpand-call edx ',name)
-				(destructuring-bind ,destructuring-lambda-list
-				    ,form-var
-				  (declare (ignore ,operator-var) , at declarations)
-				  , at real-body))
-			      :type :macro-function)))))
-
 (defmacro defun (function-name lambda-list &body body)
   "Define a function."
   (multiple-value-bind (real-body declarations docstring)




More information about the Movitz-cvs mailing list