improved defmacro. (d8402818) · Commits · movitz / movitz

losp/muerte/defmacro-bootstrap.lisp

+12 −7

Original line number	Diff line number	Diff line
		@@ -7,7 +7,7 @@
		;;;; Created at: Wed Nov 8 18:44:57 2000
		;;;; Distribution: See the accompanying file COPYING.
		;;;;
		;;;; $Id: defmacro-bootstrap.lisp,v 1.3 2008/04/12 17:11:23 ffjeld Exp $
		;;;; $Id: defmacro-bootstrap.lisp,v 1.4 2008/04/21 19:38:48 ffjeld Exp $
		;;;;
		;;;;------------------------------------------------------------------

		@@ -17,9 +17,12 @@
		(`(muerte::defmacro/compile-time ,name ,lambda-list ,macro-body)))

		(muerte.cl:defmacro muerte.cl:in-package (name)
		(let ((movitz-package-name (movitz::movitzify-package-name name)))
		`(progn
		(eval-when (:compile-toplevel)
		(in-package ,(movitz::movitzify-package-name name)))))
		(in-package ,movitz-package-name))
		(eval-when (:execute)
		(set 'package (find-package ',movitz-package-name))))))

		(in-package #:muerte)

		@@ -37,7 +40,7 @@
		(multiple-value-bind (destructuring-lambda-list whole-var env-var ignore-env ignore-operator)
		(parse-macro-lambda-list lambda-list)
		(let* ((block-name (compute-function-block-name name))
		(extras (gensym))
		(extras (gensym "extras-"))
		(form-var (or whole-var
		(gensym "form-"))))
		(cond
		@@ -50,12 +53,13 @@
		(block ,block-name
		(numargs-case
		(2 (&edx edx &optional ,form-var ,env-var)
		(declare (ignore ,@ignore-env))
		(verify-macroexpand-call edx ',name)
		(let ()
		(declare ,@declarations)
		,@real-body))
		(t (&edx edx &optional ,form-var ,env-var &rest ,extras)
		(declare (ignore ,form-var ,extras))
		(declare (ignore ,form-var ,extras ,@ignore-env))
		(verify-macroexpand-call edx ',name t))))
		:type :macro-function))
		(t `(make-named-function ,name
		@@ -65,12 +69,13 @@
		(block ,block-name
		(numargs-case
		(2 (&edx edx ,form-var ,env-var)
		(declare (ignore ,@ignore-env))
		(verify-macroexpand-call edx ',name)
		(destructuring-bind ,destructuring-lambda-list
		,form-var
		(declare (ignore ,@ignore-operator) ,@declarations)
		,@real-body))
		(t (&edx edx &optional ,form-var ,env-var &rest ,extras)
		(declare (ignore ,form-var ,extras))
		(declare (ignore ,form-var ,extras ,@ignore-env))
		(verify-macroexpand-call edx ',name t))))
		:type :macro-function)))))))