[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