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

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