0.7.4.10:

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

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 3572089..5626039 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1137,7 +1137,42 @@
   (let ((args (mapcar #'continuation-value (combination-args call)))
        (fun-name (combination-fun-source-name call)))
     (multiple-value-bind (values win)
-       (careful-call fun-name args call "constant folding")
+       (careful-call fun-name
+                     args
+                     call
+                     ;; Note: CMU CL had COMPILER-WARN here, and that
+                     ;; seems more natural, but it's probably not.
+                     ;;
+                     ;; It's especially not while bug 173 exists:
+                     ;; Expressions like
+                     ;;   (COND (END
+                     ;;          (UNLESS (OR UNSAFE? (<= END SIZE)))
+                     ;;            ...))
+                     ;; can cause constant-folding TYPE-ERRORs (in
+                     ;; #'<=) when END can be proved to be NIL, even
+                     ;; though the code is perfectly legal and safe
+                     ;; because a NIL value of END means that the
+                     ;; #'<= will never be executed.
+                     ;;
+                     ;; Moreover, even without bug 173,
+                     ;; quite-possibly-valid code like
+                     ;;   (COND ((NONINLINED-PREDICATE END)
+                     ;;          (UNLESS (<= END SIZE))
+                     ;;            ...))
+                     ;; (where NONINLINED-PREDICATE is something the
+                     ;; compiler can't do at compile time, but which
+                     ;; turns out to make the #'<= expression
+                     ;; unreachable when END=NIL) could cause errors
+                     ;; when the compiler tries to constant-fold (<=
+                     ;; END SIZE).
+                     ;;
+                     ;; So, with or without bug 173, it'd be 
+                     ;; unnecessarily evil to do a full
+                     ;; COMPILER-WARNING (and thus return FAILURE-P=T
+                     ;; from COMPILE-FILE) for legal code, so we we
+                     ;; use a wimpier COMPILE-STYLE-WARNING instead.
+                     #'compiler-style-warn
+                     "constant folding")
       (if (not win)
          (setf (combination-kind call) :error)
          (let ((dummies (make-gensym-list (length args))))