X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fproclaim.lisp;h=755467a6f618189d8d0da7f7a93191630ad067ce;hb=0e3c4b4db102bd204a30402d7e5a0de44aea57ce;hp=6e7fc387617ae82201407f9966970cb98167c370;hpb=7448b6225fa43ea6a61391990b173c09505ba45d;p=sbcl.git

diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 6e7fc38..755467a 100644
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -45,11 +45,10 @@
               (destructuring-bind (quality raw-value) q-and-v-or-just-q
                 (values quality raw-value)))
         (cond ((not (policy-quality-name-p quality))
-               (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))))
+               (or (policy-quality-deprecation-warning quality)
+                   (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~:>"
                               raw-value spec))
@@ -232,11 +231,18 @@
                      (when (type/= ctype old-type)
                        ;; FIXME: changing to FTYPE-PROCLAMATION-MISMATCH
                        ;; broke late-proclaim.lisp.
-                       (style-warn
-                        "~@<new FTYPE proclamation for ~S~@:_  ~S~@:_~
-                       does not match the old FTYPE proclamation:~@:_  ~S~@:>"
-                        name (type-specifier ctype) (type-specifier old-type)))))
-
+                       (if (info :function :info name)
+                           ;; Allow for tightening of known function types
+                           (unless (csubtypep ctype old-type)
+                             (cerror "Continue"
+                                     "~@<new FTYPE proclamation for known function ~S~@:_  ~S~@:_~
+                                      does not match its old FTYPE:~@:_  ~S~@:>"
+                                     name (type-specifier ctype) (type-specifier old-type)))
+                           (#+sb-xc-host warn
+                            #-sb-xc-host style-warn
+                            "~@<new FTYPE proclamation for ~S~@:_  ~S~@:_~
+                             does not match the old FTYPE proclamation:~@:_  ~S~@:>"
+                            name (type-specifier ctype) (type-specifier old-type))))))
                  ;; Now references to this function shouldn't be warned
                  ;; about as undefined, since even if we haven't seen a
                  ;; definition yet, we know one is planned.