src/code/defbangmacro.lisp

   1 ;;;; DEF!MACRO = cold DEFMACRO, a version of DEFMACRO which at
   2 ;;;; build-the-cross-compiler time defines its macro both in the
   3 ;;;; cross-compilation host Lisp and in the target Lisp. Basically,
   4 ;;;; DEF!MACRO does something like
   5 ;;;;   (DEFMACRO SB!XC:FOO (,@ARGS) (FOO-EXPANDER ,@ARGS))
   6 ;;;;   #+SB-XC-HOST (SB!XC:DEFMACRO FOO (,@ARGS) (FOO-EXPANDER ,@ARGS))
   7 ;;;; an idiom which would otherwise be handwritten repeatedly.
   8
   9 ;;;; This software is part of the SBCL system. See the README file for
  10 ;;;; more information.
  11 ;;;;
  12 ;;;; This software is derived from the CMU CL system, which was
  13 ;;;; written at Carnegie Mellon University and released into the
  14 ;;;; public domain. The software is in the public domain and is
  15 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  16 ;;;; files for more information.
  17
  18 (in-package "SB!IMPL")
  19
  20 (file-comment
  21   "$Header$")
  22
  23 #+sb-xc-host
  24 (progn
  25   ;; a description of the DEF!MACRO call to be stored until we get enough
  26   ;; of the system running to finish processing it
  27   (defstruct delayed-def!macro
  28     (args (required-argument) :type cons)
  29     (package *package* :type package))
  30   ;; a list of DELAYED-DEF!MACROs stored until we get DEF!MACRO working fully
  31   ;; so that we can apply it to them. After DEF!MACRO is made to work, this
  32   ;; list is processed, and then should no longer be used; it's made unbound in
  33   ;; hopes of discouraging any attempt to pushing anything more onto it.
  34   ;; (DEF!MACRO knows about this behavior, and uses the unboundness of
  35   ;; *DELAYED-DEF!MACROS* as a way to decide to just call SB!XC:DEFMACRO
  36   ;; instead of pushing onto *DELAYED-DEF!MACROS*.)
  37   (defvar *delayed-def!macros* nil))
  38
  39 ;;; KLUDGE: This is unfortunately somewhat tricky. (A lot of the
  40 ;;; cross-compilation-unfriendliness of Common Lisp comes home to roost here.)
  41 (defmacro def!macro (name &rest rest)
  42   #-(or sb-xc-host sb-xc) `(defmacro ,name ,@rest)
  43   #+sb-xc-host `(progn
  44                   (defmacro ,name ,@rest)
  45                   ,(let ((uncrossed-args `(,(uncross name) ,@rest)))
  46                      (if (boundp '*delayed-def!macros*)
  47                          `(push (make-delayed-def!macro :args ',uncrossed-args)
  48                                 *delayed-def!macros*)
  49                          `(sb!xc:defmacro ,@uncrossed-args))))
  50   ;; When cross-compiling, we don't want the DEF!MACRO to have any
  51   ;; effect at compile time, because (1) we already defined the macro
  52   ;; when building the cross-compiler, so at best it would be redundant
  53   ;; and inefficient to replace the current compiled macro body with
  54   ;; an interpreted macro body, and (2) because of the various games
  55   ;; with SB!XC vs. CL which are played when cross-compiling, we'd
  56   ;; be at risk of making an incorrect definition, with something which
  57   ;; should be e.g. calling SB!XC:TYPEP instead calling CL:TYPEP
  58   ;; and getting all confused. Using an ordinary assignment (and not
  59   ;; any special forms like DEFMACRO) guarantees that there are no
  60   ;; effects at compile time.
  61   #+sb-xc `(defmacro-mundanely ,name ,@rest))
  62
  63 #+sb-xc-host
  64 (defun force-delayed-def!macros ()
  65   (if (boundp '*delayed-def!macros*)
  66     (progn
  67       (mapcar (lambda (x)
  68                 (let ((*package* (delayed-def!macro-package x)))
  69                   (eval `(sb!xc:defmacro ,@(delayed-def!macro-args x)))))
  70               (reverse *delayed-def!macros*))
  71       ;; We shouldn't need this list any more. Making it unbound serves as a
  72       ;; signal to DEF!MACRO that it needn't delayed DEF!MACROs any more.
  73       ;; It is also generally a good thing for other reasons: it frees
  74       ;; garbage, and it discourages anyone else from pushing anything else
  75       ;; onto the list later.
  76       (makunbound '*delayed-def!macros*))
  77     ;; This condition is probably harmless if it comes up when
  78     ;; interactively experimenting with the system by loading a source
  79     ;; file into it more than once. But it's worth warning about it
  80     ;; because it definitely shouldn't come up in an ordinary build
  81     ;; process.
  82     (warn "*DELAYED-DEF!MACROS* is already unbound.")))