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 (def!macro sb!xc:defconstant (name value &optional documentation)
  13   #!+sb-doc
  14   "Define a global constant, saying that the value is constant and may be
  15   compiled into code. If the variable already has a value, and this is not
  16   EQL to the new value, the code is not portable (undefined behavior). The
  17   third argument is an optional documentation string for the variable."
  18   `(eval-when (:compile-toplevel :load-toplevel :execute)
  19      (sb!c::%defconstant ',name ,value ',documentation
  20       (sb!c:source-location))))
  21
  22 ;;; the guts of DEFCONSTANT
  23 (defun sb!c::%defconstant (name value doc source-location)
  24   (unless (symbolp name)
  25     (error "The constant name is not a symbol: ~S" name))
  26   (about-to-modify-symbol-value name)
  27   (when (looks-like-name-of-special-var-p name)
  28     (style-warn "defining ~S as a constant, even though the name follows~@
  29 the usual naming convention (names like *FOO*) for special variables"
  30                 name))
  31   (sb!c:with-source-location (source-location)
  32     (setf (info :source-location :constant name) source-location))
  33   (let ((kind (info :variable :kind name)))
  34     (case kind
  35       (:constant
  36        ;; Note: This behavior (discouraging any non-EQL modification)
  37        ;; is unpopular, but it is specified by ANSI (i.e. ANSI says a
  38        ;; non-EQL change has undefined consequences). If people really
  39        ;; want bindings which are constant in some sense other than
  40        ;; EQL, I suggest either just using DEFVAR (which is usually
  41        ;; appropriate, despite the un-mnemonic name), or defining
  42        ;; something like the DEFCONSTANT-EQX macro used in SBCL (which
  43        ;; is occasionally more appropriate). -- WHN 2001-12-21
  44        (unless (eql value
  45                     (info :variable :constant-value name))
  46          (multiple-value-bind (ignore aborted)
  47              (with-simple-restart (abort "Keep the old value.")
  48                (cerror "Go ahead and change the value."
  49                        'defconstant-uneql
  50                        :name name
  51                        :old-value (info :variable :constant-value name)
  52                        :new-value value))
  53            (declare (ignore ignore))
  54            (when aborted
  55              (return-from sb!c::%defconstant name)))))
  56       (:global
  57        ;; (This is OK -- undefined variables are of this kind. So we
  58        ;; don't warn or error or anything, just fall through.)
  59        )
  60       (t (warn "redefining ~(~A~) ~S to be a constant" kind name))))
  61   (when doc
  62     (setf (fdocumentation name 'variable) doc))
  63   #-sb-xc-host
  64   (setf (symbol-value name) value)
  65   #+sb-xc-host
  66   (progn
  67                  ;; Redefining our cross-compilation host's CL symbols
  68                  ;; would be poor form.
  69                  ;;
  70                  ;; FIXME: Having to check this and then not treat it
  71                  ;; as a fatal error seems like a symptom of things
  72                  ;; being pretty broken. It's also a problem in and of
  73                  ;; itself, since it makes it too easy for cases of
  74                  ;; using the cross-compilation host Lisp's CL
  75                  ;; constant values in the target Lisp to slip by. I
  76                  ;; got backed into this because the cross-compiler
  77                  ;; translates DEFCONSTANT SB!XC:FOO into DEFCONSTANT
  78                  ;; CL:FOO. It would be good to unscrew the
  79                  ;; cross-compilation package hacks so that that
  80                  ;; translation doesn't happen. Perhaps:
  81                  ;;   * Replace SB-XC with SB-CL. SB-CL exports all the
  82                  ;;     symbols which ANSI requires to be exported from CL.
  83                  ;;   * Make a nickname SB!CL which behaves like SB!XC.
  84                  ;;   * Go through the loaded-on-the-host code making
  85                  ;;     every target definition be in SB-CL. E.g.
  86                  ;;     DEFMACRO-MUNDANELY DEFCONSTANT becomes
  87                  ;;     DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT.
  88                  ;;   * Make IN-TARGET-COMPILATION-MODE do
  89                  ;;     UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each
  90                  ;;     of the target packages (then undo it on exit).
  91                  ;;   * Make the cross-compiler's implementation of
  92                  ;;     EVAL-WHEN (:COMPILE-TOPLEVEL) do UNCROSS.
  93                  ;;     (This may not require any change.)
  94                  ;;   * Hack GENESIS as necessary so that it outputs
  95                  ;;     SB-CL stuff as COMMON-LISP stuff.
  96                  ;;   * Now the code here can assert that the symbol
  97                  ;;     being defined isn't in the cross-compilation
  98                  ;;     host's CL package.
  99                  (unless (eql (find-symbol (symbol-name name) :cl) name)
 100                    ;; KLUDGE: In the cross-compiler, we use the
 101                    ;; cross-compilation host's DEFCONSTANT macro
 102                    ;; instead of just (SETF SYMBOL-VALUE), in order to
 103                    ;; get whatever blessing the cross-compilation host
 104                    ;; may expect for a global (SETF SYMBOL-VALUE).
 105                    ;; (CMU CL, at least around 2.4.19, generated full
 106                    ;; WARNINGs for code -- e.g. DEFTYPE expanders --
 107                    ;; which referred to symbols which had been set by
 108                    ;; (SETF SYMBOL-VALUE). I doubt such warnings are
 109                    ;; ANSI-compliant, but I'm not sure, so I've
 110                    ;; written this in a way that CMU CL will tolerate
 111                    ;; and which ought to work elsewhere too.) -- WHN
 112                    ;; 2001-03-24
 113                    (eval `(defconstant ,name ',value))))
 114
 115   (setf (info :variable :kind name) :constant
 116         (info :variable :constant-value name) value)
 117   name)