1.0.19.12: give a warning for newly deprecated stack-allcation optimization policies

[sbcl.git] / src / compiler / proclaim.lisp

diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 9dd4dc6..2f36e28 100644 (file)
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -45,11 +45,13 @@
               (destructuring-bind (quality raw-value) q-and-v-or-just-q
                 (values quality raw-value)))
         (cond ((not (policy-quality-name-p quality))
-               (compiler-warn "ignoring unknown optimization quality ~
-                               ~S in ~S"
-                               quality spec))
+               (let ((deprecation-warning (policy-quality-deprecation-warning quality spec)))
+                 (if deprecation-warning
+                     (compiler-warn deprecation-warning)
+                     (compiler-warn "~@<Ignoring unknown optimization quality ~S in:~_ ~S~:>"
+                                    quality spec))))
               ((not (typep raw-value 'policy-quality))
-               (compiler-warn "ignoring bad optimization value ~S in ~S"
+               (compiler-warn "~@<Ignoring bad optimization value ~S in:~_ ~S~:>"
                               raw-value spec))
               (t
                ;; we can't do this yet, because CLOS macros expand
@@ -172,12 +174,10 @@
        (dolist (name args)
          (unless (symbolp name)
            (error "can't declare a non-symbol as SPECIAL: ~S" name))
-         (when (constantp name)
-           (error "can't declare a constant as SPECIAL: ~S" name))
          (with-single-package-locked-error
-             (:symbol name "globally declaring ~A special"))
-         (clear-info :variable :constant-value name)
-         (setf (info :variable :kind name) :special)))
+             (:symbol name "globally declaring ~A special")
+           (about-to-modify-symbol-value name "proclaim ~S as SPECIAL")
+           (setf (info :variable :kind name) :special))))
       (type
        (if *type-system-initialized*
            (let ((type (specifier-type (first args))))
@@ -189,6 +189,8 @@
                (when (eq (info :variable :where-from name) :declared)
                  (let ((old-type (info :variable :type name)))
                    (when (type/= type old-type)
+                     ;; FIXME: changing to TYPE-PROCLAMATION-MISMATCH
+                     ;; broke late-proclaim.lisp.
                      (style-warn "The new TYPE proclamation~%  ~S~@
                                   for ~S does not match the old TYPE~@
                                   proclamation ~S"
@@ -207,6 +209,8 @@
                (when (eq (info :function :where-from name) :declared)
                  (let ((old-type (info :function :type name)))
                    (when (type/= ctype old-type)
+                     ;; FIXME: changing to FTYPE-PROCLAMATION-MISMATCH
+                     ;; broke late-proclaim.lisp.
                      (style-warn
                       "new FTYPE proclamation~@
                        ~S~@
@@ -234,7 +238,7 @@
              (setf (classoid-state class) :sealed)
              (let ((subclasses (classoid-subclasses class)))
                (when subclasses
-                 (dohash (subclass layout subclasses)
+                 (dohash ((subclass layout) subclasses :locked t)
                    (declare (ignore layout))
                    (setf (classoid-state subclass) :sealed))))))))
       (optimize