1 ;;;; This software is part of the SBCL system. See the README file for
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
))
29 (defconstant ,@(cdr whole
))
31 ,(unless (eql (find-symbol (symbol-name name
) :cl
) name
)
32 `(defconstant ,@(cdr whole
)))
34 ,(let ((form `(sb!xc
:defconstant
,@(cdr whole
))))
35 (if (boundp '*delayed-def
!constants
*)
36 `(push ',form
*delayed-def
!constants
*)
39 ;;; machinery to implement DEF!CONSTANT delays
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
*)
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."))))
57 (defun %defconstant-eqx-value
(symbol expr eqx
)
58 (declare (type function eqx
))
60 (let ((oldval (symbol-value symbol
)))
61 ;; %DEFCONSTANT will give a choice of how to proceeed on error.
62 (if (funcall eqx oldval expr
) oldval expr
))
65 ;;; generalization of DEFCONSTANT to values which are the same not
66 ;;; under EQL but under e.g. EQUAL or EQUALP
68 ;;; DEFCONSTANT-EQX is to be used instead of DEFCONSTANT for values
69 ;;; which are appropriately compared using the function given by the
70 ;;; EQX argument instead of EQL.
72 (defmacro defconstant-eqx
(symbol expr eqx
&optional doc
)
73 `(def!constant
,symbol
74 (%defconstant-eqx-value
',symbol
,expr
,eqx
)
75 ,@(when doc
(list doc
))))