compiler.cfg: more silly optimizations

basis/compiler/cfg/dce/dce.factor

@@ -49,9 +49,11 @@ M: ##write-barrier-imm build-liveness-graph
 M: ##allot build-liveness-graph
     [ dst>> allocations get adjoin ] [ call-next-method ] bi ;
 
-M: insn build-liveness-graph
+M: vreg-insn build-liveness-graph
     dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
 
+M: insn build-liveness-graph drop ;
+
 GENERIC: compute-live-vregs ( insn -- )
 
 : (record-live) ( vregs -- )
@@ -87,9 +89,11 @@ M: ##fixnum-sub compute-live-vregs record-live ;
 
 M: ##fixnum-mul compute-live-vregs record-live ;
 
-M: insn compute-live-vregs
+M: vreg-insn compute-live-vregs
     dup defs-vreg [ drop ] [ record-live ] if ;
 
+M: insn compute-live-vregs drop ;
+
 GENERIC: live-insn? ( insn -- ? )
 
 M: ##set-slot live-insn? obj>> live-vreg? ;
@@ -106,7 +110,9 @@ M: ##fixnum-sub live-insn? drop t ;
 
 M: ##fixnum-mul live-insn? drop t ;
 
-M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
+M: vreg-insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
+
+M: insn live-insn? defs-vreg drop t ;
 
 : eliminate-dead-code ( cfg -- cfg' )
     ! Even though we don't use predecessors directly, we depend
@@ -116,7 +122,7 @@ M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
 
     init-dead-code
     dup
-    [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ]
+    [ [ [ build-liveness-graph ] each ] simple-analysis ]
-    [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ]
+    [ [ [ compute-live-vregs ] each ] simple-analysis ]
-    [ [ instructions>> [ live-insn? ] filter! drop ] each-basic-block ]
+    [ [ [ live-insn? ] filter! ] simple-optimization ]
     tri ;

basis/compiler/cfg/gc-checks/gc-checks.factor

@@ -22,7 +22,8 @@ IN: compiler.cfg.gc-checks
 ! can contain tagged pointers.
 
 : insert-gc-check? ( bb -- ? )
-    instructions>> [ ##allocation? ] any? ;
+    dup kill-block?>>
+    [ drop f ] [ instructions>> [ ##allocation? ] any? ] if ;
 
 : blocks-with-gc ( cfg -- bbs )
     post-order [ insert-gc-check? ] filter ;

basis/compiler/cfg/representations/rewrite/rewrite.factor

@@ -89,15 +89,13 @@ M: ##copy conversions-for-insn , ;
 
 M: insn conversions-for-insn , ;
 
-: conversions-for-block ( bb -- )
+: conversions-for-block ( insns -- insns )
     [
-        [
+        alternatives get clear-assoc
-            alternatives get clear-assoc
+        [ conversions-for-insn ] each
-            [ conversions-for-insn ] each
+    ] V{ } make ;
-        ] V{ } make
-    ] change-instructions drop ;
 
 : insert-conversions ( cfg -- )
     H{ } clone alternatives set
     V{ } clone renaming-set set
-    [ conversions-for-block ] each-basic-block ;
+    [ conversions-for-block ] simple-optimization ;

basis/compiler/cfg/rpo/rpo.factor

@@ -44,5 +44,13 @@ SYMBOL: visited
 : simple-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... )
     '[ _ optimize-basic-block ] each-basic-block ; inline
 
+: analyze-basic-block ( bb quot -- )
+    over kill-block?>> [ 2drop ] [
+        [ dup basic-block set instructions>> ] dip call
+    ] if ; inline
+
+: simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )
+    '[ _ analyze-basic-block ] each-basic-block ; inline
+
 : needs-post-order ( cfg -- cfg' )
     dup post-order drop ;

basis/compiler/cfg/ssa/construction/construction.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2009 Slava Pestov.
+! Copyright (C) 2009, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel accessors sequences fry assocs
 sets math combinators
@@ -42,10 +42,9 @@ SYMBOL: defs-multi
     H{ } clone defs set
     H{ } clone defs-multi set
     [
-        dup instructions>> [
+        [ basic-block get ] dip
-            compute-insn-defs
+        [ compute-insn-defs ] with each
-        ] with each
+    ] simple-analysis ;
-    ] each-basic-block ;
 
 ! Maps basic blocks to sequences of vregs
 SYMBOL: inserting-phi-nodes
@@ -88,7 +87,9 @@ RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ]
 
 GENERIC: rename-insn ( insn -- )
 
-M: insn rename-insn
+M: insn rename-insn drop ;
+
+M: vreg-insn rename-insn
     [ ssa-rename-insn-uses ]
     [ ssa-rename-insn-defs ]
     bi ;

basis/compiler/cfg/ssa/destruction/destruction.factor

@@ -76,7 +76,9 @@ GENERIC: prepare-insn ( insn -- )
 
 : try-to-coalesce ( dst src -- ) 2array copies get push ;
 
-M: insn prepare-insn
+M: insn prepare-insn drop ;
+
+M: vreg-insn prepare-insn
     [ temp-vregs [ leader-map get conjoin ] each ]
     [
         [ defs-vreg ] [ uses-vregs ] bi