basis/compiler/cfg/block-joining/block-joining.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators.short-circuit kernel sequences math
   4 compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
   5 compiler.cfg.predecessors compiler.cfg.utilities ;
   6 IN: compiler.cfg.block-joining
   7
   8 ! Joining blocks that are not calls and are connected by a single CFG edge.
   9 ! This pass does not update ##phi nodes and should therefore only run
  10 ! before stack analysis.
  11 : join-block? ( bb -- ? )
  12     {
  13         [ kill-block? not ]
  14         [ predecessors>> length 1 = ]
  15         [ predecessor kill-block? not ]
  16         [ predecessor successors>> length 1 = ]
  17         [ [ predecessor ] keep back-edge? not ]
  18     } 1&& ;
  19
  20 : join-instructions ( bb pred -- )
  21     [ instructions>> ] bi@ dup pop* push-all ;
  22
  23 : update-successors ( bb pred -- )
  24     [ successors>> ] dip successors<< ;
  25
  26 : join-block ( bb pred -- )
  27     [ join-instructions ] [ update-successors ] 2bi ;
  28
  29 : join-blocks ( cfg -- cfg' )
  30     needs-predecessors
  31
  32     dup post-order [
  33         dup join-block?
  34         [ dup predecessor join-block ] [ drop ] if
  35     ] each
  36
  37     cfg-changed predecessors-changed ;