src/macro-utils.lisp

   1 (uiop:define-package #:lw2.macro-utils
   2   (:documentation "Facilities for working with macros.")
   3   (:use #:cl #:iterate #:trivial-cltl2)
   4   (:import-from #:introspect-environment #:compiler-macroexpand #:compiler-macroexpand-1)
   5   (:export #:compiler-constantp #:macroexpand-both-1 #:macroexpand-both
   6            #:eval-in-environment
   7            #:augment-macros #:macro-as-lambda #:macro-list-as-lambdas))
   8
   9 (in-package #:lw2.macro-utils)
  10
  11 (defun compiler-constantp (form &optional environment)
  12   "Like CONSTANTP, but also try expanding compiler macros."
  13   (or (constantp form environment)
  14       (constantp (compiler-macroexpand form environment) environment)))
  15
  16 (defun macroexpand-both-1 (form &optional environment)
  17   (multiple-value-bind (result expandedp) (macroexpand-1 form environment)
  18     (multiple-value-bind (result c-expandedp) (compiler-macroexpand-1 result environment)
  19       (values result (or expandedp c-expandedp)))))
  20
  21 (defun macroexpand-both (form &optional environment)
  22   (let (result expandedp any-expandedp)
  23     (iter
  24      (multiple-value-setq (result expandedp) (macroexpand-both-1 form environment))
  25      (while expandedp)
  26      (setf any-expandedp t))
  27     (values result any-expandedp)))
  28
  29 (defun eval-in-environment (form &optional environment)
  30   (funcall (enclose `(lambda () ,form) environment)))
  31
  32 (defun augment-macros (environment macro-bindings)
  33   "Add a set of MACROLET-style macro bindings to an environment."
  34   (let ((macro-list (iter (for (name args . body) in macro-bindings)
  35                           (for macro-lambda = (parse-macro name args body))
  36                           (for macro-fn = (enclose macro-lambda environment))
  37                           (collect (list name macro-fn)))))
  38     (augment-environment environment :macro macro-list)))
  39
  40 (defmacro macro-as-lambda (name args &body body)
  41   "Create a macro expander function as a lambda form."
  42   (parse-macro name args body))
  43
  44 (defmacro macro-list-as-lambdas (&rest clauses)
  45   "Create a list of macro expander functions as lambda forms. This is
  46 suitable for passing to AUGMENT-ENVIRONMENT."
  47   `(list
  48     ,@(iter (for (name args . body) in clauses)
  49             (collect `(list ',name ,(parse-macro name args body))))))