src/compiler/defconstant.lisp

   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.
   9
  10 (in-package "SB!IMPL")
  11
  12 ;;; We need a mechanism different from the usual SYMBOL-VALUE during cross-
  13 ;;; compilation so we don't clobber the host Lisp's manifest constants.
  14 ;;; This was formerly done using the globaldb, so emulate exactly the
  15 ;;; calls to UNCROSS in (SETF INFO) and INFO because that works just fine.
  16 ;;; Also, as noted in 'constantp.lisp'
  17 ;;;   "KLUDGE: superficially, this might look good enough..."
  18 ;;; we should enforce that we not wrongly look at a host constant where
  19 ;;; a target constant is intended. This specialized accessor, in lieu of INFO
  20 ;;; facilitates implementing something like that, though in fact ir1tran is
  21 ;;; already able to generate some warnings about host constant usage.
  22 #+sb-xc-host
  23 (progn
  24   (defun (setf sb!c::xc-constant-value) (newval sym)
  25     (setf (get (uncross sym) :sb-xc-constant-val) newval))
  26   (defun sb!c::xc-constant-value (sym) ; return 2 values as does (INFO ...)
  27     (multiple-value-bind (indicator value foundp)
  28         (get-properties (symbol-plist (uncross sym)) '(:sb-xc-constant-val))
  29       (declare (ignore indicator))
  30       (values value (not (null foundp))))))
  31
  32 (def!macro sb!xc:defconstant (name value &optional (doc nil docp))
  33   #!+sb-doc
  34   "Define a global constant, saying that the value is constant and may be
  35   compiled into code. If the variable already has a value, and this is not
  36   EQL to the new value, the code is not portable (undefined behavior). The
  37   third argument is an optional documentation string for the variable."
  38   `(eval-when (:compile-toplevel :load-toplevel :execute)
  39      (sb!c::%defconstant ',name ,value (sb!c:source-location)
  40                          ,@(and docp
  41                                 `(',doc)))))
  42
  43 (declaim (ftype (function (symbol t &optional t t) (values null &optional))
  44                 about-to-modify-symbol-value))
  45 ;;; the guts of DEFCONSTANT
  46
  47 ;; Abridged version for cold-init: No warnings are allowed,
  48 ;; but %DEFCONSTANT gets mad that *UNIVERSAL-TYPE* etc have earmuffs.
  49 #+sb-xc
  50 (defun sb!c::!%quietly-defconstant (name value source-location)
  51   (when source-location
  52     (setf (info :source-location :constant name) source-location))
  53   (%set-symbol-value name value)
  54   (setf (info :variable :kind name) :constant))
  55
  56 (defun sb!c::%defconstant (name value source-location &optional (doc nil docp))
  57   #+sb-xc-host (declare (ignore doc docp))
  58   (unless (symbolp name)
  59     (error "The constant name is not a symbol: ~S" name))
  60   (with-single-package-locked-error (:symbol name
  61                                              "defining ~s as a constant")
  62    (when (looks-like-name-of-special-var-p name)
  63      (style-warn 'asterisks-around-constant-variable-name
  64                  :format-control "Defining ~S as a constant"
  65                  :format-arguments (list name)))
  66    (when source-location
  67      (setf (info :source-location :constant name) source-location))
  68    (let ((kind (info :variable :kind name)))
  69      (case kind
  70        (:constant
  71         ;; Note: This behavior (discouraging any non-EQL modification)
  72         ;; is unpopular, but it is specified by ANSI (i.e. ANSI says a
  73         ;; non-EQL change has undefined consequences). If people really
  74         ;; want bindings which are constant in some sense other than
  75         ;; EQL, I suggest either just using DEFVAR (which is usually
  76         ;; appropriate, despite the un-mnemonic name), or defining
  77         ;; something like the DEFCONSTANT-EQX macro used in SBCL (which
  78         ;; is occasionally more appropriate). -- WHN 2001-12-21
  79         (if (boundp name)
  80             (if (typep name '(or boolean keyword))
  81                 ;; Non-continuable error.
  82                 (about-to-modify-symbol-value name 'defconstant)
  83                 (let ((old (symbol-value name)))
  84                   (unless (eql value old)
  85                     (multiple-value-bind (ignore aborted)
  86                         (with-simple-restart (abort "Keep the old value.")
  87                           (cerror "Go ahead and change the value."
  88                                   'defconstant-uneql
  89                                   :name name
  90                                   :old-value old
  91                                   :new-value value))
  92                       (declare (ignore ignore))
  93                       (when aborted
  94                         (return-from sb!c::%defconstant name))))))
  95             (warn "redefining a MAKUNBOUND constant: ~S" name)))
  96        (:unknown
  97         ;; (This is OK -- undefined variables are of this kind. So we
  98         ;; don't warn or error or anything, just fall through.)
  99         )
 100        (t (warn "redefining ~(~A~) ~S to be a constant" kind name)))))
 101   ;; We ought to be consistent in treating any change of :VARIABLE :KIND
 102   ;; as a continuable error. The above CASE expression pre-dates the
 103   ;; existence of symbol-macros (I believe), but at a bare minimum,
 104   ;; INFO should return NIL for its second value if requesting the
 105   ;; :macro-expansion of something that is getting defined as constant.
 106   (clear-info :variable :macro-expansion name)
 107   (clear-info :source-location :symbol-macro name)
 108   #-sb-xc-host
 109   (progn
 110     (when docp
 111       (setf (fdocumentation name 'variable) doc))
 112     (%set-symbol-value name value))
 113   #+sb-xc-host
 114   (progn
 115     ;; Redefining our cross-compilation host's CL symbols would be poor form.
 116     ;;
 117     ;; FIXME: Having to check this and then not treat it as a fatal error
 118     ;; seems like a symptom of things being pretty broken. It's also a problem
 119     ;; in and of itself, since it makes it too easy for cases of using the
 120     ;; cross-compilation host Lisp's CL constant values in the target Lisp to
 121     ;; slip by. I got backed into this because the cross-compiler translates
 122     ;; DEFCONSTANT SB!XC:FOO into DEFCONSTANT CL:FOO. It would be good to
 123     ;; unscrew the cross-compilation package hacks so that that translation
 124     ;; doesn't happen. Perhaps: * Replace SB-XC with SB-CL. SB-CL exports all
 125     ;; the symbols which ANSI requires to be exported from CL. * Make a
 126     ;; nickname SB!CL which behaves like SB!XC. * Go through the
 127     ;; loaded-on-the-host code making every target definition be in SB-CL.
 128     ;; E.g. SB!XC:DEFMACRO DEFCONSTANT becomes SB!XC:DEFMACRO SB!CL:DEFCONSTANT.
 129     ;; * Make IN-TARGET-COMPILATION-MODE do UNUSE-PACKAGE CL and
 130     ;; USE-PACKAGE SB-CL in each of the target packages (then undo it
 131     ;; on exit). * Make the cross-compiler's implementation of EVAL-WHEN
 132     ;; (:COMPILE-TOPLEVEL) do UNCROSS. (This may not require any change.) *
 133     ;; Hack GENESIS as necessary so that it outputs SB-CL stuff as COMMON-LISP
 134     ;; stuff. * Now the code here can assert that the symbol being defined
 135     ;; isn't in the cross-compilation host's CL package.
 136     (unless (eql (find-symbol (symbol-name name) :cl) name)
 137       ;; KLUDGE: In the cross-compiler, we use the cross-compilation host's
 138       ;; DEFCONSTANT macro instead of just (SETF SYMBOL-VALUE), in order to
 139       ;; get whatever blessing the cross-compilation host may expect for a
 140       ;; global (SETF SYMBOL-VALUE). (CMU CL, at least around 2.4.19,
 141       ;; generated full WARNINGs for code -- e.g. DEFTYPE expanders -- which
 142       ;; referred to symbols which had been set by (SETF SYMBOL-VALUE). I
 143       ;; doubt such warnings are ANSI-compliant, but I'm not sure, so I've
 144       ;; written this in a way that CMU CL will tolerate and which ought to
 145       ;; work elsewhere too.) -- WHN 2001-03-24
 146       (eval `(defconstant ,name ',value)))
 147     ;; It would certainly be awesome if this was only needed for symbols
 148     ;; in CL. Unfortunately, that is not the case. Maybe some are moved
 149     ;; back in CL later on?
 150     (setf (sb!c::xc-constant-value name) value))
 151   (setf (info :variable :kind name) :constant)
 152   name)