X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1-translators.lisp;h=4c5a861faa30d3863016c7b28fb86075855263fc;hb=98f3f617894ce24a40764aa98606ce68c5482cf0;hp=46c3deee9dc8174646cbf0a1a4a57b26504e30f6;hpb=ec735ab75335c1744b39190314142a7e6f1ecdb3;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 46c3dee..4c5a861 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -35,6 +35,8 @@
 	 (node (make-if :test pred
 			:consequent then-block
 			:alternative else-block)))
+    ;; IR1-CONVERT-MAYBE-PREDICATE requires DEST to be CIF, so the
+    ;; order of the following two forms is important
     (setf (continuation-dest pred) node)
     (ir1-convert start pred test)
     (link-node-to-previous-continuation node pred)
@@ -442,7 +444,7 @@
 			  thing
 			  :debug-name (debug-namify "#'~S" thing)
 			  :allow-debug-catch-tag t)))
-	((setf)
+	((setf sb!pcl::class-predicate)
 	 (let ((var (find-lexically-apparent-fun
 		     thing "as the argument to FUNCTION")))
 	   (reference-leaf start cont var)))
@@ -813,7 +815,10 @@
   (declare (type continuation start cont) (type basic-var var))
   (let ((dest (make-continuation)))
     (ir1-convert start dest value)
-    (assert-continuation-type dest (leaf-type var) (lexenv-policy *lexenv*))
+    (assert-continuation-type dest
+                              (or (lexenv-find var type-restrictions)
+                                  (leaf-type var))
+                              (lexenv-policy *lexenv*))
     (let ((res (make-set :var var :value dest)))
       (setf (continuation-dest dest) res)
       (setf (leaf-ever-used var) t)
@@ -958,9 +963,6 @@
 		     fun
 		     `(%coerce-callable-to-fun ,fun)))
     (setf (continuation-dest fun-cont) node)
-    (assert-continuation-type fun-cont
-			      (specifier-type '(or function symbol))
-                              (lexenv-policy *lexenv*))
     (collect ((arg-conts))
       (let ((this-start fun-cont))
 	(dolist (arg args)