Make some instances of IF/IF conversion more direct

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

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 4992ea4..9c01bc1 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -660,7 +660,8 @@
 ;;; is the case.
 ;;; Similarly, when both branches are equivalent, branch directly to either
 ;;; of them.
-;;; Also, if the test has multiple uses, replicate the node when possible.
+;;; Also, if the test has multiple uses, replicate the node when possible...
+;;; in fact, splice in direct jumps to the right branch if possible.
 (defun ir1-optimize-if (node)
   (declare (type cif node))
   (let ((test (if-test node))
@@ -675,23 +676,67 @@
                    alternative)
                   ((type= type (specifier-type 'null))
                    consequent)
-                  ((cblocks-equivalent-p alternative consequent)
+                  ((or (eq consequent alternative) ; Can this happen?
+                       (cblocks-equivalent-p alternative consequent))
                    alternative))))
       (when victim
-        (flush-dest test)
-        (when (rest (block-succ block))
-          (unlink-blocks block victim))
-        (setf (component-reanalyze (node-component node)) t)
-        (unlink-node node)
+        (kill-if-branch-1 node test block victim)
         (return-from ir1-optimize-if (values))))
+    (tension-if-if-1 node test block)
+    (duplicate-if-if-1 node test block)
+    (values)))
 
-    (when (and (eq (block-start-node block) node)
-               (listp (lvar-uses test)))
-      (do-uses (use test)
-        (when (immediately-used-p test use)
-          (convert-if-if use node)
-          (when (not (listp (lvar-uses test))) (return))))))
-  (values))
+;; When we know that we only have a single successor, kill the victim
+;; ... unless the victim and the remaining successor are the same.
+(defun kill-if-branch-1 (node test block victim)
+  (declare (type cif node))
+  (flush-dest test)
+  (when (rest (block-succ block))
+    (unlink-blocks block victim))
+  (setf (component-reanalyze (node-component node)) t)
+  (unlink-node node))
+
+;; When if/if conversion would leave (if ... (if nil ...)) or
+;; (if ... (if not-nil ...)), splice the correct successor right
+;; in.
+(defun tension-if-if-1 (node test block)
+  (when (and (eq (block-start-node block) node)
+             (listp (lvar-uses test)))
+    (do-uses (use test)
+      (when (immediately-used-p test use)
+        (let* ((type (single-value-type (node-derived-type use)))
+               (target (if (type= type (specifier-type 'null))
+                           (if-alternative node)
+                           (multiple-value-bind (typep surep)
+                               (ctypep nil type)
+                             (and (not typep) surep
+                                  (if-consequent node))))))
+          (when target
+            (let ((pred (node-block use)))
+              (cond ((listp (lvar-uses test))
+                     (change-block-successor pred block target)
+                     (delete-lvar-use use))
+                    (t
+                     ;; only one use left. Just kill the now-useless
+                     ;; branch to avoid spurious code deletion notes.
+                     (aver (rest (block-succ block)))
+                     (kill-if-branch-1
+                      node test block
+                      (if (eql target (if-alternative node))
+                          (if-consequent node)
+                          (if-alternative node)))
+                     (return-from tension-if-if-1))))))))))
+
+;; Finally, duplicate EQ-nil tests
+(defun duplicate-if-if-1 (node test block)
+  (when (and (eq (block-start-node block) node)
+             (listp (lvar-uses test)))
+    (do-uses (use test)
+      (when (immediately-used-p test use)
+        (convert-if-if use node)
+        ;; leave the last use as is, instead of replacing
+        ;; the (singly-referenced) CIF node with a duplicate.
+        (when (not (listp (lvar-uses test))) (return))))))
 
 ;;; Create a new copy of an IF node that tests the value of the node
 ;;; USE. The test must have >1 use, and must be immediately used by