1.0.5.30: small PCL re-organization
[sbcl/lichteblau.git] / src / code / defbangmacro.lisp
blob723a04e609f55752729212cf1a4f782a95de9b01
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.
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.
18 (in-package "SB!IMPL")
20 #+sb-xc-host
21 (progn
22 ;; a description of the DEF!MACRO call to be stored until we get enough
23 ;; of the system running to finish processing it
24 (defstruct delayed-def!macro
25 (args (missing-arg) :type cons)
26 (package (sane-package) :type package))
27 ;; a list of DELAYED-DEF!MACROs stored until we get DEF!MACRO working fully
28 ;; so that we can apply it to them. After DEF!MACRO is made to work, this
29 ;; list is processed, and then should no longer be used; it's made unbound in
30 ;; hopes of discouraging any attempt to pushing anything more onto it.
31 ;; (DEF!MACRO knows about this behavior, and uses the unboundness of
32 ;; *DELAYED-DEF!MACROS* as a way to decide to just call SB!XC:DEFMACRO
33 ;; instead of pushing onto *DELAYED-DEF!MACROS*.)
34 (defvar *delayed-def!macros* nil))
36 ;;; KLUDGE: This is unfortunately somewhat tricky. (A lot of the
37 ;;; cross-compilation-unfriendliness of Common Lisp comes home to roost here.)
38 (defmacro def!macro (name &rest rest)
39 #-(or sb-xc-host sb-xc) `(defmacro ,name ,@rest)
40 #+sb-xc-host `(progn
41 (defmacro ,name ,@rest)
42 ,(let ((uncrossed-args `(,(uncross name) ,@rest)))
43 (if (boundp '*delayed-def!macros*)
44 `(push (make-delayed-def!macro :args ',uncrossed-args)
45 *delayed-def!macros*)
46 `(sb!xc:defmacro ,@uncrossed-args))))
47 ;; When cross-compiling, we don't want the DEF!MACRO to have any
48 ;; effect at compile time, because (1) we already defined the macro
49 ;; when building the cross-compiler, so at best it would be redundant
50 ;; and inefficient to replace the current compiled macro body with
51 ;; an interpreted macro body, and (2) because of the various games
52 ;; with SB!XC vs. CL which are played when cross-compiling, we'd
53 ;; be at risk of making an incorrect definition, with something which
54 ;; should be e.g. calling SB!XC:TYPEP instead calling CL:TYPEP
55 ;; and getting all confused. Using an ordinary assignment (and not
56 ;; any special forms like DEFMACRO) guarantees that there are no
57 ;; effects at compile time.
58 #+sb-xc `(defmacro-mundanely ,name ,@rest))
60 #+sb-xc-host
61 (defun force-delayed-def!macros ()
62 (if (boundp '*delayed-def!macros*)
63 (progn
64 (mapcar (lambda (x)
65 (let ((*package* (delayed-def!macro-package x)))
66 (eval `(sb!xc:defmacro ,@(delayed-def!macro-args x)))))
67 (reverse *delayed-def!macros*))
68 ;; We shouldn't need this list any more. Making it unbound serves as a
69 ;; signal to DEF!MACRO that it needn't delayed DEF!MACROs any more.
70 ;; It is also generally a good thing for other reasons: it frees
71 ;; garbage, and it discourages anyone else from pushing anything else
72 ;; onto the list later.
73 (makunbound '*delayed-def!macros*))
74 ;; This condition is probably harmless if it comes up when
75 ;; interactively experimenting with the system by loading a source
76 ;; file into it more than once. But it's worth warning about it
77 ;; because it definitely shouldn't come up in an ordinary build
78 ;; process.
79 (warn "*DELAYED-DEF!MACROS* is already unbound.")))