basis/compiler/tree/dead-code/branches/branches.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs columns combinators compiler.tree
   4 compiler.tree.dead-code.liveness compiler.tree.dead-code.simple
   5 fry kernel namespaces sequences stack-checker.backend
   6 stack-checker.branches ;
   7 FROM: namespaces => set ;
   8 IN: compiler.tree.dead-code.branches
   9
  10 M: #if mark-live-values* look-at-inputs ;
  11
  12 M: #dispatch mark-live-values* look-at-inputs ;
  13
  14 : look-at-phi ( value outputs inputs -- )
  15     [ index ] dip swap [ <column> look-at-values ] [ drop ] if* ;
  16
  17 M: #phi compute-live-values*
  18     #! If any of the outputs of a #phi are live, then the
  19     #! corresponding inputs are live too.
  20     [ out-d>> ] [ phi-in-d>> ] bi look-at-phi ;
  21
  22 SYMBOL: if-node
  23
  24 M: #branch remove-dead-code*
  25     [ [ [ (remove-dead-code) ] map ] change-children ]
  26     [ if-node set ]
  27     bi ;
  28
  29 : remove-phi-inputs ( #phi -- )
  30     if-node get children>>
  31     [ dup ends-with-terminate? [ drop f ] [ last out-d>> ] if ] map
  32     pad-with-bottom >>phi-in-d drop ;
  33
  34 : live-value-indices ( values -- indices )
  35     [ length iota ] keep live-values get
  36     '[ _ nth _ key? ] filter ; inline
  37
  38 : drop-indexed-values ( values indices -- node )
  39     [ drop filter-live ] [ swap nths ] 2bi
  40     [ length make-values ] keep
  41     [ drop ] [ zip ] 2bi
  42     <#data-shuffle> ;
  43
  44 : insert-drops ( nodes values indices -- nodes' )
  45     '[
  46         over ends-with-terminate?
  47         [ drop ] [ _ drop-indexed-values suffix ] if
  48     ] 2map ;
  49
  50 : hoist-drops ( #phi -- )
  51     if-node get swap
  52     [ phi-in-d>> ] [ out-d>> live-value-indices ] bi
  53     '[ _ _ insert-drops ] change-children drop ;
  54
  55 : remove-phi-outputs ( #phi -- )
  56     [ filter-live ] change-out-d drop ;
  57
  58 M: #phi remove-dead-code*
  59     {
  60         [ hoist-drops ]
  61         [ remove-phi-inputs ]
  62         [ remove-phi-outputs ]
  63         [ ]
  64     } cleave ;