Make some instances of IF/IF conversion more direct

When faced with CFGs that look like (if (if ...) ...), we duplicate
the outer NULL test forward in the branches (and jump to the correct
branch, so very little code is duplicated).  However, this transform
depends on later ir1 optimisation to handle patterns like
(if (if ... nil t) ...).  Try and get them right with a specialised
rewrite to get good code even when ir1opt doesn't run until fixpoint.

Also, refactored the code a bit while working on it.

diff --git a/NEWS b/NEWS
index 1e49cf6..a7761d0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -87,6 +87,9 @@ changes relative to sbcl-1.1.7:
     integer constants are handled more cleverly, especially when they
     can be represented as sign-extended (signed-byte 32). (Based on a
     patch by Douglas Katzman)
+  * optimization: IF/IF conversion should reliably result in sane code
+    when (some of) the results of the inner IF are always false or
+    always true.
 
 changes in sbcl-1.1.7 relative to sbcl-1.1.6:
   * enhancement: TRACE :PRINT-ALL handles multiple-valued forms.

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