Merge branch 'master' into global_optimization

[factor.git] / basis / compiler / cfg / useless-blocks / useless-blocks.factor

diff --git a/basis/compiler/cfg/useless-blocks/useless-blocks.factor b/basis/compiler/cfg/useless-blocks/useless-blocks.factor
index 05cb13748b3120cbefb5dec542e1a4314424708b..cbe006b4d7b893048e59cd60ddae75a2ff4452cc 100644 (file)
--- a/basis/compiler/cfg/useless-blocks/useless-blocks.factor
+++ b/basis/compiler/cfg/useless-blocks/useless-blocks.factor
@@ -1,10 +1,12 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences combinators classes vectors
-compiler.cfg compiler.cfg.rpo compiler.cfg.instructions ;
+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
@@ -12,9 +14,13 @@ IN: compiler.cfg.useless-blocks
     ] change-successors drop ;
 
 : update-successor-for-delete ( bb -- )
-    [ predecessors>> first ]
-    [ successors>> first predecessors>> ]
-    bi set-first ;
+    ! 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 ]
@@ -23,17 +29,17 @@ IN: compiler.cfg.useless-blocks
 
 : delete-basic-block? ( bb -- ? )
     {
-        { [ dup instructions>> length 1 = not ] [ f ] }
-        { [ dup predecessors>> length 1 = not ] [ f ] }
-        { [ dup successors>> length 1 = not ] [ f ] }
-        { [ dup instructions>> first ##branch? not ] [ f ] }
-        [ t ]
-    } cond nip ;
+        [ 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 ;
+    ] each-basic-block
+    f >>post-order ;
 
 : delete-conditional? ( bb -- ? )
     dup instructions>> [ drop f ] [
@@ -46,10 +52,11 @@ IN: compiler.cfg.useless-blocks
 
 : delete-conditional ( bb -- )
     dup successors>> first 1vector >>successors
-    [ but-last f \ ##branch boa suffix ] change-instructions
+    [ 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 ;
+    ] each-basic-block
+    f >>post-order ;