src/code/macroexpand.lisp

   1 ;;;; MACROEXPAND and friends
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!IMPL")
  13 \f
  14 ;;;; syntactic environment access
  15
  16 (defun sb!xc:special-operator-p (symbol)
  17   #!+sb-doc
  18   "If the symbol globally names a special form, return T, otherwise NIL."
  19   (declare (symbol symbol))
  20   (eq (info :function :kind symbol) :special-form))
  21
  22 (defvar sb!xc:*macroexpand-hook* 'funcall
  23   #!+sb-doc
  24   "The value of this variable must be a designator for a function that can
  25   take three arguments, a macro expander function, the macro form to be
  26   expanded, and the lexical environment to expand in. The function should
  27   return the expanded form. This function is called by MACROEXPAND-1
  28   whenever a runtime expansion is needed. Initially this is set to
  29   FUNCALL.")
  30
  31 (declaim (ftype (function (t &optional (or null sb!c::lexenv))) sb!xc:macroexpand-1))
  32 (defun sb!xc:macroexpand-1 (form &optional env)
  33   #!+sb-doc
  34   "If form is a macro (or symbol macro), expand it once. Return two values,
  35    the expanded form and a T-or-NIL flag indicating whether the form was, in
  36    fact, a macro. ENV is the lexical environment to expand in, which defaults
  37    to the null environment."
  38   (cond ((and (consp form) (symbolp (car form)))
  39          (let ((def (sb!xc:macro-function (car form) env)))
  40            (if def
  41                (values (funcall sb!xc:*macroexpand-hook*
  42                                 def
  43                                 form
  44                                 ;; As far as I can tell, it's not clear from
  45                                 ;; the ANSI spec whether a MACRO-FUNCTION
  46                                 ;; function needs to be prepared to handle
  47                                 ;; NIL as a lexical environment. CMU CL
  48                                 ;; passed NIL through to the MACRO-FUNCTION
  49                                 ;; function, but I prefer SBCL "be conservative
  50                                 ;; in what it sends and liberal in what it
  51                                 ;; accepts" by doing the defaulting itself.
  52                                 ;; -- WHN 19991128
  53                                 (coerce-to-lexenv env))
  54                        t)
  55                (values form nil))))
  56         ((symbolp form)
  57          (let* ((venv (when env (sb!c::lexenv-vars env)))
  58                 (local-def (cdr (assoc form venv))))
  59            (cond ((and (consp local-def)
  60                        (eq (car local-def) 'macro))
  61                   (values (cdr local-def) t))
  62                  ((eq (info :variable :kind form) :macro)
  63                   (values (info :variable :macro-expansion form) t))
  64                  (t
  65                   (values form nil)))))
  66         (t
  67          (values form nil))))
  68
  69 (declaim (ftype (function (t &optional (or null sb!c::lexenv))) sb!xc:macroexpand))
  70 (defun sb!xc:macroexpand (form &optional env)
  71   #!+sb-doc
  72   "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.
  73    Returns the final resultant form, and T if it was expanded. ENV is the
  74    lexical environment to expand in, or NIL (the default) for the null
  75    environment."
  76   (labels ((frob (form expanded)
  77              (multiple-value-bind (new-form newly-expanded-p)
  78                  (sb!xc:macroexpand-1 form env)
  79                (if newly-expanded-p
  80                    (frob new-form t)
  81                    (values new-form expanded)))))
  82     (frob form nil)))