X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fconstraint.lisp;h=e2be0938884ce119eebd89a76d83cb03487cb74a;hb=94ac5b7c3ff37850210b6fc9a7593cf1c5752993;hp=c4c97557c7a82f56db4eb57b2855d07f62902efb;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index c4c9755..e2be093 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -126,50 +126,52 @@
      (add-complement-constraints if 'typep (ok-ref-lambda-var use)
 				 (specifier-type 'null) t))
     (combination
-     (let ((name (continuation-function-name
-		  (basic-combination-fun use)))
-	   (args (basic-combination-args use)))
-       (case name
-	 ((%typep %instance-typep)
-	  (let ((type (second args)))
-	    (when (constant-continuation-p type)
-	      (let ((val (continuation-value type)))
-	      (add-complement-constraints if 'typep
-					  (ok-cont-lambda-var (first args))
-					  (if (ctype-p val)
-					      val
-					      (specifier-type val))
-					  nil)))))
-	 ((eq eql)
-	  (let* ((var1 (ok-cont-lambda-var (first args)))
-		 (arg2 (second args))
-		 (var2 (ok-cont-lambda-var arg2)))
-	    (cond ((not var1))
-		  (var2
-		   (add-complement-constraints if 'eql var1 var2 nil))
-		  ((constant-continuation-p arg2)
-		   (add-complement-constraints if 'eql var1
-					       (ref-leaf
-						(continuation-use arg2))
-					       nil)))))
-	 ((< >)
-	  (let* ((arg1 (first args))
-		 (var1 (ok-cont-lambda-var arg1))
-		 (arg2 (second args))
-		 (var2 (ok-cont-lambda-var arg2)))
-	    (when var1
-	      (add-complement-constraints if name var1 (continuation-type arg2)
-					  nil))
-	    (when var2
-	      (add-complement-constraints if (if (eq name '<) '> '<)
-					  var2 (continuation-type arg1)
-					  nil))))
-	 (t
-	  (let ((ptype (gethash name *backend-predicate-types*)))
-	    (when ptype
-	      (add-complement-constraints if 'typep
-					  (ok-cont-lambda-var (first args))
-					  ptype nil))))))))
+     (unless (eq (combination-kind use)
+                 :error)
+       (let ((name (continuation-fun-name
+                    (basic-combination-fun use)))
+             (args (basic-combination-args use)))
+         (case name
+           ((%typep %instance-typep)
+            (let ((type (second args)))
+              (when (constant-continuation-p type)
+                (let ((val (continuation-value type)))
+                  (add-complement-constraints if 'typep
+                                              (ok-cont-lambda-var (first args))
+                                              (if (ctype-p val)
+                                                  val
+                                                  (specifier-type val))
+                                              nil)))))
+           ((eq eql)
+            (let* ((var1 (ok-cont-lambda-var (first args)))
+                   (arg2 (second args))
+                   (var2 (ok-cont-lambda-var arg2)))
+              (cond ((not var1))
+                    (var2
+                     (add-complement-constraints if 'eql var1 var2 nil))
+                    ((constant-continuation-p arg2)
+                     (add-complement-constraints if 'eql var1
+                                                 (ref-leaf
+                                                  (continuation-use arg2))
+                                                 nil)))))
+           ((< >)
+            (let* ((arg1 (first args))
+                   (var1 (ok-cont-lambda-var arg1))
+                   (arg2 (second args))
+                   (var2 (ok-cont-lambda-var arg2)))
+              (when var1
+                (add-complement-constraints if name var1 (continuation-type arg2)
+                                            nil))
+              (when var2
+                (add-complement-constraints if (if (eq name '<) '> '<)
+                                            var2 (continuation-type arg1)
+                                            nil))))
+           (t
+            (let ((ptype (gethash name *backend-predicate-types*)))
+              (when ptype
+                (add-complement-constraints if 'typep
+                                            (ok-cont-lambda-var (first args))
+                                            ptype nil)))))))))
   (values))
 
 ;;; Set the TEST-CONSTRAINT in the successors of BLOCK according to
@@ -443,7 +445,7 @@
 ;;; Our OUT is:
 ;;;     out U (in - kill)
 ;;;
-;;; BLOCK-KILL-LIST is just a list of the lambda-vars killed, so we must
+;;; BLOCK-KILL-LIST is just a list of the LAMBDA-VARs killed, so we must
 ;;; compute the kill set when there are any vars killed. We bum this a
 ;;; bit by special-casing when only one var is killed, and just using
 ;;; that var's constraints as the kill set. This set could possibly be
@@ -458,7 +460,7 @@
 		      res))
 		   (t
 		    (let ((*compiler-error-context* (block-last block)))
-		      (compiler-warning
+		      (compiler-warn
 		       "unreachable code in constraint ~
 			propagation -- apparent compiler bug"))
 		    (make-sset))))