(eval-when (:compile-toplevel :load-toplevel :execute)
(defun get-macro (name macro-functions &optional errorp)
(let ((macro-function (cdr (assoc name macro-functions))))
(when macro-function (return-from get-macro macro-function))
(when errorp (error "No macro definition for ~S." name)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun macro-lambda-list (lambda-list whole env)
"Ensure &whole and &environment in LAMBDA-LIST."
(when (eq (first lambda-list) '&whole)
(setq whole (second lambda-list))
(setq lambda-list (cddr lambda-list)))
(loop with env-p = nil
for (element . tail) on lambda-list
when (eq element '&environment)
do (setq env-p t env (car tail))
finally (unless env-p
(setq lambda-list (list* '&environment env lambda-list)))
(setq lambda-list (list* '&whole whole lambda-list))
(return (values lambda-list whole env)))))
(defmacro macrolet+ ((&rest macro-definitions) &body body &environment environment)
(loop with whole = (gensym (string 'whole)) and env = (gensym (string 'environment))
for (name lambda-list . macro-body) in macro-definitions
for macro-function = (macro-function name environment)
collect (cons name macro-function) into old-macro-functions
collect (multiple-value-bind (lambda-list whole env)
(macro-lambda-list lambda-list whole env)
`(,name ,lambda-list
(flet ((next-macro-p ()
"Return true if there is a next macro."
(get-macro ',name ',old-macro-functions))
(call-next-macro (&rest macro-arguments &aux (,whole ,whole))
"Call the next (outer) MACRO-FUNCTION, or else signal an error."
(when macro-arguments (setq ,whole (list* ',name macro-arguments)))
(let ((next-macro (get-macro ',name ',old-macro-functions t)))
(funcall *macroexpand-hook* next-macro ,whole ,env))))
(declare (dynamic-extent #'next-macro-p))
(declare (dynamic-extent #'call-next-macro))
,@macro-body))) into new-macro-definitions
;; Now each macro definition can use CALL-NEXT-MACRO.
finally (return `(macrolet ,new-macro-definitions
,@body))))
Quick example
(macrolet+ ((foo (x) (if (numberp x) "It's a number." (call-next-macro))))
(macrolet+ ((foo (x) (if (eql x 7) "Lucky." (call-next-macro))))
(values (foo 12) (foo 13) (foo 1234567890) (foo 7))))
Evaluating the above gives the values:
"It's a number."
"It's a number."
"It's a number."
"Lucky."
The first three macro calls (corresponding to the inner definition) invoked call-next-macro, while the last one didn't.
(macrolet+ ((foo (x) (if (numberp x) "It's a number." (call-next-macro))))
(macrolet+ ((foo (x) (if (eql x 7) "Lucky." (call-next-macro))))
(values (foo 12) (foo 13) (foo 1234567890) (foo 'not-a-number))))
This signals an error:
> Error: No macro definition for FOO. > While executing: GET-MACRO, in process listener(1). > Type :POP to abort, :R for a list of available restarts. > Type :? for other options.
In other words, there isn't any global definition of the foo macro. Availability can be checked with next-macro-p.
Related reading
- MACROLET and lexical environment
- CLHS: Section 3.1.1.4—Environment Objects
- Issue MACRO-ENVIRONMENT-EXTENT:DYNAMIC
Apache 2