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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors combinators combinators.short-circuit
   4 compiler.cfg compiler.cfg.predecessors compiler.cfg.rpo
   5 compiler.cfg.utilities kernel sequences ;
   6 IN: compiler.cfg.block-joining
   7
   8 : join-block? ( bb -- ? )
   9     {
  10         [ kill-block?>> not ]
  11         [ predecessors>> length 1 = ]
  12         [ predecessor kill-block?>> not ]
  13         [ predecessor successors>> length 1 = ]
  14         [ [ predecessor ] keep back-edge? not ]
  15     } 1&& ;
  16
  17 : join-instructions ( bb pred -- )
  18     [ instructions>> ] bi@ dup pop* push-all ;
  19
  20 : update-successors ( bb pred -- )
  21     [ successors>> ] dip successors<< ;
  22
  23 : join-block ( bb pred -- )
  24     [ join-instructions ] [ update-successors ] 2bi ;
  25
  26 : join-blocks ( cfg -- )
  27     {
  28         [ needs-predecessors ]
  29         [
  30             post-order [
  31                 dup join-block?
  32                 [ dup predecessor join-block ] [ drop ] if
  33             ] each
  34         ]
  35         [ cfg-changed ]
  36         [ predecessors-changed ]
  37     } cleave ;