X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=2a7f9a1005d176342889c0c8b1109bd2a926a3a0;hb=a74b0bdb483504f6faddf8089f848f61ed94b92a;hp=02b83404f7121a28e73546816a787c2d4a42f4a7;hpb=25e76ec2b1083ac6a4bba42af7ad7b5a8239f2b8;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 02b8340..2a7f9a1 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -580,7 +580,7 @@
 ;;; all functions in the tail set to be equivalent, this amounts to
 ;;; bringing the entire tail set up to date. We iterate over the
 ;;; returns for all the functions in the tail set, reanalyzing them
-;;; all (not treating Node specially.)
+;;; all (not treating NODE specially.)
 ;;;
 ;;; When we are done, we check whether the new type is different from
 ;;; the old TAIL-SET-TYPE. If so, we set the type and also reoptimize
@@ -1340,7 +1340,7 @@
 ;;; -- either continuation has a funky TYPE-CHECK annotation.
 ;;; -- the continuations have incompatible assertions, so the new asserted type
 ;;;    would be NIL.
-;;; -- the var's DEST has a different policy than the ARG's (think safety).
+;;; -- the VAR's DEST has a different policy than the ARG's (think safety).
 ;;;
 ;;; We change the REF to be a reference to NIL with unused value, and
 ;;; let it be flushed as dead code. A side effect of this substitution
@@ -1354,7 +1354,7 @@
 	 (dest (continuation-dest cont)))
     (when (and (eq (continuation-use cont) ref)
 	       dest
-	       (not (typep dest '(or creturn exit mv-combination)))
+	       (continuation-single-value-p cont)
 	       (eq (node-home-lambda ref)
 		   (lambda-home (lambda-var-home var)))
 	       (member (continuation-type-check arg) '(t nil))
@@ -1455,9 +1455,9 @@
 ;;; If the function has an XEP, then we don't do anything, since we
 ;;; won't discover anything.
 ;;;
-;;; We can clear the Continuation-Reoptimize flags for arguments in
-;;; all calls corresponding to changed arguments in Call, since the
-;;; only use in IR1 optimization of the Reoptimize flag for local call
+;;; We can clear the CONTINUATION-REOPTIMIZE flags for arguments in
+;;; all calls corresponding to changed arguments in CALL, since the
+;;; only use in IR1 optimization of the REOPTIMIZE flag for local call
 ;;; args is right here.
 (defun propagate-local-call-args (call fun)
   (declare (type combination call) (type clambda fun))
@@ -1680,7 +1680,7 @@
 		   (setf (node-prev use) nil)
 		   (setf (continuation-next node-prev) nil)
 		   (collect ((res vals))
-		     (loop as cont = (make-continuation use)
+		     (loop for cont = (make-continuation use)
 			   and prev = node-prev then cont
 			   repeat (- nvars nvals)
 			   do (reference-constant prev cont nil)
@@ -1713,6 +1713,8 @@
 ;;; CONVERT-MV-BIND-TO-LET. We grab the args of LIST and make them
 ;;; args of the VALUES-LIST call, flushing the old argument
 ;;; continuation (allowing the LIST to be flushed.)
+;;;
+;;; FIXME: Thus we lose possible type assertions on (LIST ...).
 (defoptimizer (values-list optimizer) ((list) node)
   (let ((use (continuation-use list)))
     (when (and (combination-p use)
@@ -1734,8 +1736,7 @@
 ;;; to a PROG1. This allows the computation of the additional values
 ;;; to become dead code.
 (deftransform values ((&rest vals) * * :node node)
-  (when (typep (continuation-dest (node-cont node))
-	       '(or creturn exit mv-combination))
+  (unless (continuation-single-value-p (node-cont node))
     (give-up-ir1-transform))
   (setf (node-derived-type node) *wild-type*)
   (if vals