Change branch splitting around a bit, rename useless-blocks to useless-conditionals and rewrite it

basis/compiler/cfg/branch-splitting/branch-splitting.factor

@@ -1,24 +1,31 @@
-! Copyright (C) 2009 Doug Coleman.
+! Copyright (C) 2009 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit compiler.cfg.def-use
+USING: accessors combinators.short-circuit kernel math sequences
-compiler.cfg.rpo kernel math sequences ;
+compiler.cfg.def-use compiler.cfg compiler.cfg.rpo ;
 IN: compiler.cfg.branch-splitting
 
-: split-branch ( branch -- )
+! Predecessors must be recomputed after this
+
+: split-branch-for ( bb predecessor -- )
     [
-        [ instructions>> ] [ predecessors>> ] bi [
+        [
-            instructions>> [ pop* ] [ push-all ] bi
+            <basic-block>
-        ] with each
+                swap
-    ] [
+                [ instructions>> [ clone ] map >>instructions ]
-        [ successors>> ] [ predecessors>> ] bi [
+                [ successors>> clone >>successors ]
-            [ drop clone ] change-successors drop
+                bi
-        ] with each
+        ] keep
-    ] bi ;
+    ] dip
+    [ [ 2dup eq? [ 2drop ] [ 2nip ] if ] with with map ] change-successors
+    drop ;
+
+: split-branch ( bb -- )
+    dup predecessors>> [ split-branch-for ] with each ;
 
 : split-branches? ( bb -- ? )
     {
-        [ predecessors>> length 1 >= ]
+        [ successors>> empty? ]
-        [ successors>> length 1 <= ]
+        [ predecessors>> length 1 > ]
         [ instructions>> [ defs-vregs ] any? not ]
         [ instructions>> [ temp-vregs ] any? not ]
     } 1&& ;
@@ -26,4 +33,5 @@ IN: compiler.cfg.branch-splitting
 : split-branches ( cfg -- cfg' )
     dup [
         dup split-branches? [ split-branch ] [ drop ] if
-    ] each-basic-block f >>post-order ;
+    ] each-basic-block
+    f >>post-order ;

basis/compiler/cfg/cfg.factor

@@ -1,7 +1,9 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel arrays vectors accessors
-namespaces math make fry sequences ;
+namespaces math make fry sequences
+combinators.short-circuit
+compiler.cfg.instructions ;
 IN: compiler.cfg
 
 TUPLE: basic-block < identity-tuple
@@ -20,6 +22,15 @@ M: basic-block hashcode* nip id>> ;
         V{ } clone >>predecessors
         \ basic-block counter >>id ;
 
+: empty-block? ( bb -- ? )
+    instructions>> {
+        [ length 1 = ]
+        [ first ##branch? ]
+    } 1&& ;
+
+: skip-empty-blocks ( bb -- bb' )
+    dup empty-block? [ successors>> first skip-empty-blocks ] when ;
+
 : add-instructions ( bb quot -- )
     [ instructions>> building ] dip '[
         building get pop

basis/compiler/cfg/optimizer/optimizer.factor

@@ -3,8 +3,9 @@
 USING: kernel sequences accessors combinators namespaces
 compiler.cfg.tco
 compiler.cfg.predecessors
-compiler.cfg.useless-blocks
+compiler.cfg.useless-conditionals
 compiler.cfg.stack-analysis
+compiler.cfg.branch-splitting
 compiler.cfg.alias-analysis
 compiler.cfg.value-numbering
 compiler.cfg.dce
@@ -26,8 +27,9 @@ SYMBOL: check-optimizer?
     [
         optimize-tail-calls
         compute-predecessors
-        ! delete-useless-blocks
         delete-useless-conditionals
+        split-branches
+        compute-predecessors
         stack-analysis
         compute-liveness
         alias-analysis

basis/compiler/cfg/tco/tco.factor

@@ -11,6 +11,7 @@ IN: compiler.cfg.tco
 ! Tail call optimization. You must run compute-predecessors after this
 
 : return? ( bb -- ? )
+    skip-empty-blocks
     instructions>> {
         [ length 2 = ]
         [ first ##epilogue? ]

basis/compiler/cfg/useless-blocks/useless-blocks-tests.factor

@@ -1,11 +0,0 @@
-IN: compiler.cfg.useless-blocks.tests
-USING: fry kernel sequences compiler.cfg.useless-blocks compiler.cfg.checker
-compiler.cfg.debugger compiler.cfg.predecessors tools.test ;
-
-{
-    [ [ drop 1 ] when ]
-    [ [ drop 1 ] unless ]
-} [
-    [ [ ] ] dip
-    '[ _ test-cfg first compute-predecessors delete-useless-blocks check-cfg ] unit-test
-] each

basis/compiler/cfg/useless-blocks/useless-blocks.factor

@@ -1,62 +0,0 @@
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences combinators combinators.short-circuit
-classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
-IN: compiler.cfg.useless-blocks
-
-: update-predecessor-for-delete ( bb -- )
-    ! We have to replace occurrences of bb with bb's successor
-    ! in bb's predecessor's list of successors.
-    dup predecessors>> first [
-        [
-            2dup eq? [ drop successors>> first ] [ nip ] if
-        ] with map
-    ] change-successors drop ;
-
-: update-successor-for-delete ( bb -- )
-    ! We have to replace occurrences of bb with bb's predecessor
-    ! in bb's sucessor's list of predecessors.
-    dup successors>> first [
-        [
-            2dup eq? [ drop predecessors>> first ] [ nip ] if
-        ] with map
-    ] change-predecessors drop ;
-
-: delete-basic-block ( bb -- )
-    [ update-predecessor-for-delete ]
-    [ update-successor-for-delete ]
-    bi ;
-
-: delete-basic-block? ( bb -- ? )
-    {
-        [ instructions>> length 1 = ]
-        [ predecessors>> length 1 = ]
-        [ successors>> length 1 = ]
-        [ instructions>> first ##branch? ]
-    } 1&& ;
-
-: delete-useless-blocks ( cfg -- cfg' )
-    dup [
-        dup delete-basic-block? [ delete-basic-block ] [ drop ] if
-    ] each-basic-block
-    f >>post-order ;
-
-: delete-conditional? ( bb -- ? )
-    dup instructions>> [ drop f ] [
-        last class {
-            ##compare-branch
-            ##compare-imm-branch
-            ##compare-float-branch
-        } memq? [ successors>> first2 eq? ] [ drop f ] if
-    ] if-empty ;
-
-: delete-conditional ( bb -- )
-    dup successors>> first 1vector >>successors
-    [ but-last \ ##branch new-insn suffix ] change-instructions
-    drop ;
-
-: delete-useless-conditionals ( cfg -- cfg' )
-    dup [
-        dup delete-conditional? [ delete-conditional ] [ drop ] if
-    ] each-basic-block
-    f >>post-order ;

basis/compiler/cfg/useless-conditionals/useless-conditionals.factor

@@ -0,0 +1,22 @@
+! Copyright (C) 2008, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences math combinators combinators.short-circuit
+classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ;
+IN: compiler.cfg.useless-conditionals
+
+: delete-conditional? ( bb -- ? )
+    {
+        [ instructions>> length 1 > ]
+        [ instructions>> last class { ##compare-branch ##compare-imm-branch ##compare-float-branch } memq? ]
+        [ successors>> first2 [ skip-empty-blocks ] bi@ eq? ]
+    } 1&& ;
+
+: delete-conditional ( bb -- )
+    [ first skip-empty-blocks 1vector ] change-successors
+    instructions>> [ pop* ] [ [ \ ##branch new-insn ] dip push ] bi ;
+
+: delete-useless-conditionals ( cfg -- cfg' )
+    dup [
+        dup delete-conditional? [ delete-conditional ] [ drop ] if
+    ] each-basic-block
+    f >>post-order ;