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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs fry kernel math math.order
   4 namespaces sequences sorting vectors compiler.cfg.def-use
   5 compiler.cfg.dominance compiler.cfg.registers ;
   6 IN: compiler.cfg.ssa.destruction.forest
   7
   8 TUPLE: dom-forest-node vreg bb children ;
   9
  10 <PRIVATE
  11
  12 : sort-vregs-by-bb ( vregs -- alist )
  13     defs get
  14     '[ dup _ at ] { } map>assoc
  15     [ [ second pre-of ] compare ] sort ;
  16
  17 : <dom-forest-node> ( vreg bb parent -- node )
  18     [ V{ } clone dom-forest-node boa dup ] dip children>> push ;
  19
  20 : <virtual-root> ( -- node )
  21     f f V{ } clone dom-forest-node boa ;
  22
  23 : find-parent ( pre stack -- parent )
  24     2dup last vreg>> def-of maxpre-of > [
  25         dup pop* find-parent
  26     ] [ nip last ] if ;
  27
  28 : (compute-dom-forest) ( vreg bb stack -- )
  29     [ dup pre-of ] dip [ find-parent <dom-forest-node> ] keep push ;
  30
  31 PRIVATE>
  32
  33 : compute-dom-forest ( vregs -- forest )
  34     <virtual-root> [
  35         1vector
  36         [ sort-vregs-by-bb ] dip
  37         '[ _ (compute-dom-forest) ] assoc-each
  38     ] keep children>> ;