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 ;;; Return *MACROEXPAND-HOOK* as a compiled function, or signal an error
  32 ;;; if that's not possible. Having an interpreted function as the expander
  33 ;;; hook can easily lead to an infinite loop.
  34 ;;; Something insane like a generic function with an interpreted method
  35 ;;; on CONS would appear to be a compiled-function. Nothing can prevent that,
  36 ;;; but hopefully this wrapper protects against reasonable mistakes.
  37 (defun valid-macroexpand-hook (&optional (hook sb!xc:*macroexpand-hook*))
  38   (when (eq hook 'funcall)
  39     (return-from valid-macroexpand-hook #'funcall))
  40   ;; If you mistakenly bind the hook to a un-fboundp symbol (esp. NIL),
  41   ;; it is nicer to say that the hook is invalid rather than randomly
  42   ;; getting "unbound function" at indeterminate places in your code.
  43   (let ((fun (if (functionp hook)
  44                  hook
  45                  ;; We need to get the function named by the designator.
  46                  ;; The type proclamation in 'cl-specials' seems to think
  47                  ;; that SETF functions are permitted here, though that
  48                  ;; really seems like a bug. If it is permitted,
  49                  ;; we can't use SYMBOL-FUNCTION. But using FDEFINITION
  50                  ;; would strip encapsulations, so use %COERCE-NAME-TO-FUN.
  51                  ;; (This allows tracing the macroexpand-hook, e.g.)
  52                  (and (fboundp hook)
  53                       #+sb-xc-host (fdefinition hook)
  54                       #-sb-xc-host (%coerce-name-to-fun hook)))))
  55     ;; We could do one of several things instead of failing:
  56     ;; - preprocess the body to ensure that there are no macros,
  57     ;;   and install that body, letting it run interpreted.
  58     ;; - call COMPILE and install it as the FIN-FUNCTION, and use that.
  59     ;; - call COMPILE and just return the result, which is a horrible
  60     ;;   technique, as it would call COMPILE once per macro usage.
  61     (if (compiled-function-p fun)
  62         fun
  63         (error 'sb!kernel::macroexpand-hook-type-error
  64                :datum hook
  65                :expected-type 'compiled-function))))
  66
  67 (defun sb!xc:macroexpand-1 (form &optional env)
  68   #!+sb-doc
  69   "If form is a macro (or symbol macro), expand it once. Return two values,
  70    the expanded form and a T-or-NIL flag indicating whether the form was, in
  71    fact, a macro. ENV is the lexical environment to expand in, which defaults
  72    to the null environment."
  73   (flet ((perform-expansion (expander &optional (expansion nil expansion-p))
  74            ;; There is no compelling reason to coerce NIL to a LEXENV when
  75            ;; supplying it to a user-defined macro which receives &ENVIRONMENT,
  76            ;; and it is expressly the wrong thing to do. An environment is
  77            ;; opaque, and the only thing you can legally do with one is pass
  78            ;; it to a standard functions defined to receive it.
  79            ;; The validity of NIL as an "environment object" is undeniably
  80            ;; legal in *any* usage demanding one, based on CLHS 3.1.1.3.1.
  81            ;; Importantly, macros can sense when they are producing code for the
  82            ;; compiler or interpreter based on the type of environment.
  83            (let ((hook (truly-the function (valid-macroexpand-hook))))
  84              (values (if (eq hook #'funcall)
  85                          (if expansion-p expansion (funcall expander form env))
  86                          (funcall hook expander form env))
  87                      t)))
  88          (symbol-expansion (sym env)
  89            (flet ((global-expansion () (info :variable :macro-expansion sym)))
  90              (typecase env
  91                (null (global-expansion))
  92                #!+(and sb-fasteval (host-feature sb-xc))
  93                (sb!interpreter:basic-env
  94                 (multiple-value-bind (cell kind frame-ptr def)
  95                     (sb!interpreter:find-lexical-var env sym)
  96                   (declare (ignore cell frame-ptr))
  97                   (cond ((eq kind :macro) (values def t))
  98                         ((null kind) (global-expansion))
  99                         (t (values nil nil)))))
 100                (lexenv
 101                 (let ((def (cdr (assoc sym (sb!c::lexenv-vars env)))))
 102                   (cond ((null def) (global-expansion))
 103                         ((listp def) (values (cdr def) t))
 104                         (t (values nil nil)))))))))
 105     (acond ((symbolp form)
 106             (multiple-value-bind (exp expanded-p) (symbol-expansion form env)
 107               ;; CLHS 3.1.2.1.1 specifies that symbol-macros are expanded
 108               ;; via the macroexpand hook.
 109               (if expanded-p
 110                   (perform-expansion #'symbol-expansion exp)
 111                   (values form nil))))
 112            ((and (listp form)
 113                  (let ((fn (car form)))
 114                    (and (symbolp fn) (sb!xc:macro-function fn env))))
 115             (perform-expansion it))
 116            (t
 117             (values form nil)))))
 118
 119 (defun sb!xc:macroexpand (form &optional env)
 120   #!+sb-doc
 121   "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.
 122    Returns the final resultant form, and T if it was expanded. ENV is the
 123    lexical environment to expand in, or NIL (the default) for the null
 124    environment."
 125   (labels ((frob (form expanded)
 126              (multiple-value-bind (new-form newly-expanded-p)
 127                  (sb!xc:macroexpand-1 form env)
 128                (if newly-expanded-p
 129                    (frob new-form t)
 130                    (values new-form expanded)))))
 131     (frob form nil)))
 132
 133 ;;; Like MACROEXPAND-1, but takes care not to expand special forms.
 134 (defun %macroexpand-1 (form &optional env)
 135   (if (or (atom form)
 136           (let ((op (car form)))
 137             (not (and (symbolp op) (sb!xc:special-operator-p op)))))
 138       (sb!xc:macroexpand-1 form env)
 139       (values form nil)))
 140
 141 ;;; Like MACROEXPAND, but takes care not to expand special forms.
 142 (defun %macroexpand (form &optional env)
 143   (labels ((frob (form expanded)
 144              (multiple-value-bind (new-form newly-expanded-p)
 145                  (%macroexpand-1 form env)
 146                (if newly-expanded-p
 147                    (frob new-form t)
 148                    (values new-form expanded)))))
 149     (frob form nil)))