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