1.0.5.30: small PCL re-organization
[sbcl/lichteblau.git] / src / code / defbangconstant.lisp
blob9c5d0e7662afa203a798cea49b73ba889c852023
1 ;;;; This software is part of the SBCL system. See the README file for
2 ;;;; more information.
3 ;;;;
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
10 (in-package "SB!KERNEL")
12 ;;;; the DEF!CONSTANT macro
14 ;;; FIXME: This code was created by cut-and-paste from the
15 ;;; corresponding code for DEF!TYPE. DEF!CONSTANT, DEF!TYPE and
16 ;;; DEF!MACRO are currently very parallel, and if we ever manage to
17 ;;; rationalize the use of UNCROSS in the cross-compiler, they should
18 ;;; become completely parallel, at which time they should be merged to
19 ;;; eliminate the duplicate code.
21 ;;; *sigh* -- Even the comments are cut'n'pasted :-/ If I were more
22 ;;; confident in my understanding, I might try to do drastic surgery,
23 ;;; but my head is currently spinning (host? target? both?) so I'll go
24 ;;; for the minimal changeset... -- CSR, 2002-05-11
25 (defmacro def!constant (&whole whole name value &optional doc)
26 (declare (ignore value doc #-sb-xc-host name))
27 `(progn
28 #-sb-xc-host
29 (defconstant ,@(cdr whole))
30 #+sb-xc-host
31 ,(unless (eql (find-symbol (symbol-name name) :cl) name)
32 `(defconstant ,@(cdr whole)))
33 #+sb-xc-host
34 ,(let ((form `(sb!xc:defconstant ,@(cdr whole))))
35 (if (boundp '*delayed-def!constants*)
36 `(push ',form *delayed-def!constants*)
37 form))))
39 ;;; machinery to implement DEF!CONSTANT delays
40 #+sb-xc-host
41 (progn
42 (/show "binding *DELAYED-DEF!CONSTANTS*")
43 (defvar *delayed-def!constants* nil)
44 (/show "done binding *DELAYED-DEF!CONSTANTS*")
45 (defun force-delayed-def!constants ()
46 (if (boundp '*delayed-def!constants*)
47 (progn
48 (mapc #'eval *delayed-def!constants*)
49 (makunbound '*delayed-def!constants*))
50 ;; This condition is probably harmless if it comes up when
51 ;; interactively experimenting with the system by loading a
52 ;; source file into it more than once. But it's worth warning
53 ;; about it because it definitely shouldn't come up in an
54 ;; ordinary build process.
55 (warn "*DELAYED-DEF!CONSTANTS* is already unbound."))))