0.6.10.15:

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

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index d588f17..9c853d1 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -15,9 +15,6 @@
 ;;;; files for more information.
 
 (in-package "SB!C")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; interface for obtaining results of constant folding
 
@@ -642,7 +639,7 @@
 #!+sb-show
 (defvar *show-transforms-p* nil)
 
-;;; Do IR1 optimizations on a Combination node.
+;;; Do IR1 optimizations on a COMBINATION node.
 (declaim (ftype (function (combination) (values)) ir1-optimize-combination))
 (defun ir1-optimize-combination (node)
   (when (continuation-reoptimize (basic-combination-fun node))
@@ -844,7 +841,23 @@
        ((valid-function-use call type
                             :argument-test #'always-subtypep
                             :result-test #'always-subtypep
-                            :error-function #'compiler-warning
+                            ;; KLUDGE: Common Lisp is such a dynamic
+                            ;; language that all we can do here in
+                            ;; general is issue a STYLE-WARNING. It
+                            ;; would be nice to issue a full WARNING
+                            ;; in the special case of of type
+                            ;; mismatches within a compilation unit
+                            ;; (as in section 3.2.2.3 of the spec)
+                            ;; but at least as of sbcl-0.6.11, we
+                            ;; don't keep track of whether the
+                            ;; mismatched data came from the same
+                            ;; compilation unit, so we can't do that.
+                            ;; -- WHN 2001-02-11
+                            ;;
+                            ;; FIXME: Actually, I think we could
+                            ;; issue a full WARNING if the call
+                            ;; violates a DECLAIM FTYPE.
+                            :error-function #'compiler-style-warning
                             :warning-function #'compiler-note)
         (assert-call-type call type)
         (maybe-terminate-block call ir1-p)
@@ -923,8 +936,8 @@
         (constrained (function-type-p type))
         (table (component-failed-optimizations *component-being-compiled*))
         (flame (if (transform-important transform)
-                   (policy node (>= speed brevity))
-                   (policy node (> speed brevity))))
+                   (policy node (>= speed inhibit-warnings))
+                   (policy node (> speed inhibit-warnings))))
         (*compiler-error-context* node))
     (cond ((not (member (transform-when transform)
                        (if *byte-compiling*
@@ -1124,8 +1137,8 @@
                         cont-atype
                         (continuation-asserted-type arg))
                        *empty-type*))
-              (eq (lexenv-cookie (node-lexenv dest))
-                  (lexenv-cookie (node-lexenv (continuation-dest arg)))))
+              (eq (lexenv-policy (node-lexenv dest))
+                  (lexenv-policy (node-lexenv (continuation-dest arg)))))
       (assert (member (continuation-kind arg)
                      '(:block-start :deleted-block-start :inside-block)))
       (assert-continuation-type arg cont-atype)
@@ -1390,7 +1403,8 @@
            (return-from ir1-optimize-mv-call)))
 
        (let ((count (cond (total-nvals)
-                          ((and (policy node (zerop safety)) (eql min max))
+                          ((and (policy node (zerop safety))
+                                (eql min max))
                            min)
                           (t nil))))
          (when count