X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdefconstant.lisp;h=735f29a86c736438195c8b07e553e406ead88d0e;hb=31f072311935e32751508ecf824905c6b58a1d95;hp=3356b18c946d715d88d49c6c9edfca63540560e6;hpb=8731c1a7c1a585d190151fa881050fb5e14c0616;p=sbcl.git

diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp
index 3356b18..735f29a 100644
--- a/src/compiler/defconstant.lisp
+++ b/src/compiler/defconstant.lisp
@@ -16,17 +16,20 @@
   EQL to the new value, the code is not portable (undefined behavior). The
   third argument is an optional documentation string for the variable."
   `(eval-when (:compile-toplevel :load-toplevel :execute)
-     (sb!c::%defconstant ',name ,value ',documentation)))
+     (sb!c::%defconstant ',name ,value ',documentation
+      (sb!c:source-location))))
 
 ;;; the guts of DEFCONSTANT
-(defun sb!c::%defconstant (name value doc)
+(defun sb!c::%defconstant (name value doc source-location)
   (unless (symbolp name)
     (error "The constant name is not a symbol: ~S" name))
   (about-to-modify-symbol-value name)
   (when (looks-like-name-of-special-var-p name)
     (style-warn "defining ~S as a constant, even though the name follows~@
 the usual naming convention (names like *FOO*) for special variables"
-		name))
+                name))
+  (sb!c:with-source-location (source-location)
+    (setf (info :source-location :constant name) source-location))
   (let ((kind (info :variable :kind name)))
     (case kind
       (:constant
@@ -39,10 +42,17 @@ the usual naming convention (names like *FOO*) for special variables"
        ;; something like the DEFCONSTANT-EQX macro used in SBCL (which
        ;; is occasionally more appropriate). -- WHN 2001-12-21
        (unless (eql value
-		    (info :variable :constant-value name))
-	 (cerror "Go ahead and change the value."
-		 "The constant ~S is being redefined."
-		 name)))
+                    (info :variable :constant-value name))
+         (multiple-value-bind (ignore aborted)
+             (with-simple-restart (abort "Keep the old value.")
+               (cerror "Go ahead and change the value."
+                       'defconstant-uneql
+                       :name name
+                       :old-value (info :variable :constant-value name)
+                       :new-value value))
+           (declare (ignore ignore))
+           (when aborted
+             (return-from sb!c::%defconstant name)))))
       (:global
        ;; (This is OK -- undefined variables are of this kind. So we
        ;; don't warn or error or anything, just fall through.)
@@ -68,14 +78,14 @@ the usual naming convention (names like *FOO*) for special variables"
                  ;; CL:FOO. It would be good to unscrew the
                  ;; cross-compilation package hacks so that that
                  ;; translation doesn't happen. Perhaps:
-                 ;;   * Replace SB-XC with SB-CL. SB-CL exports all the 
+                 ;;   * Replace SB-XC with SB-CL. SB-CL exports all the
                  ;;     symbols which ANSI requires to be exported from CL.
                  ;;   * Make a nickname SB!CL which behaves like SB!XC.
                  ;;   * Go through the loaded-on-the-host code making
                  ;;     every target definition be in SB-CL. E.g.
                  ;;     DEFMACRO-MUNDANELY DEFCONSTANT becomes
                  ;;     DEFMACRO-MUNDANELY SB!CL:DEFCONSTANT.
-                 ;;   * Make IN-TARGET-COMPILATION-MODE do 
+                 ;;   * Make IN-TARGET-COMPILATION-MODE do
                  ;;     UNUSE-PACKAGE CL and USE-PACKAGE SB-CL in each
                  ;;     of the target packages (then undo it on exit).
                  ;;   * Make the cross-compiler's implementation of
@@ -103,5 +113,5 @@ the usual naming convention (names like *FOO*) for special variables"
                    (eval `(defconstant ,name ',value))))
 
   (setf (info :variable :kind name) :constant
-	(info :variable :constant-value name) value)
+        (info :variable :constant-value name) value)
   name)