X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcheckgen.lisp;h=134e3b8989db4ddf0e88f695109da54193eea29b;hb=98a76d4426660876dec6649b1e228d2e5b47f579;hp=8b43ae35c438139f8edf80b9126b9dfd9187a297;hpb=7ce2c42adf3d62f03086de940adaee48e6161a40;p=sbcl.git

diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp
index 8b43ae3..134e3b8 100644
--- a/src/compiler/checkgen.lisp
+++ b/src/compiler/checkgen.lisp
@@ -117,21 +117,15 @@
 ;;;; checking strategy determination
 
 ;;; Return the type we should test for when we really want to check
-;;; for TYPE. If speed, space or compilation speed is more important
-;;; than safety, then we return a weaker type if it is easier to
-;;; check. First we try the defined type weakenings, then look for any
-;;; predicate that is cheaper.
+;;; for TYPE. If type checking policy is "fast", then we return a
+;;; weaker type if it is easier to check. First we try the defined
+;;; type weakenings, then look for any predicate that is cheaper.
 (defun maybe-weaken-check (type policy)
   (declare (type ctype type))
-  (cond ((policy policy (zerop safety))
-         *wild-type*)
-        ((policy policy
-		 (and (<= speed safety)
-		      (<= space safety)
-		      (<= compilation-speed safety)))
-	 type)
-	(t
-	 (weaken-values-type type))))
+  (ecase (policy policy type-check)
+    (0 *wild-type*)
+    (2 (weaken-values-type type))
+    (3 type)))
 
 ;;; This is like VALUES-TYPES, only we mash any complex function types
 ;;; to FUNCTION.
@@ -232,7 +226,7 @@
 	(dest (continuation-dest cont)))
     (aver (not (eq ctype *wild-type*)))
     (multiple-value-bind (ctypes count) (no-fun-values-types ctype)
-      (multiple-value-bind (atypes acount) (no-fun-values-types ctype)
+      (multiple-value-bind (atypes acount) (no-fun-values-types atype)
         (aver (eq count acount))
         (cond ((not (eq count :unknown))
                (if (or (exit-p dest)
@@ -259,7 +253,11 @@
     (not (or (values-subtypep (continuation-proven-type cont)
                               (continuation-type-to-check cont))
              (and (combination-p dest)
-                  (eq (combination-kind dest) :full)
+                  (let ((kind (combination-kind dest)))
+                    (or (eq kind :full)
+                        (and (fun-info-p kind)
+                             (null (fun-info-templates kind))
+                             (not (fun-info-ir2-convert kind)))))
                   ;; The theory is that the type assertion is from a
                   ;; declaration in (or on) the callee, so the callee
                   ;; should be able to do the check. We want to let