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