core/optimizer/def-use/def-use.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: namespaces assocs sequences kernel generic assocs classes
   4 vectors accessors combinators inference.dataflow inference.backend ;
   5 IN: optimizer.def-use
   6
   7 SYMBOL: def-use
   8
   9 : used-by ( value -- seq ) def-use get at ;
  10
  11 : unused? ( value -- ? )
  12     used-by empty? ;
  13
  14 : uses-values ( node seq -- )
  15     [ def-use get push-at ] with each ;
  16
  17 : defs-values ( seq -- )
  18     #! If there is no value, set it to a new empty vector,
  19     #! otherwise do nothing.
  20     [ def-use get [ V{ } like ] change-at ] each ;
  21
  22 GENERIC: node-def-use ( node -- )
  23
  24 : compute-def-use ( node -- node )
  25     H{ } clone def-use set
  26     dup [ node-def-use ] each-node ;
  27
  28 : nest-def-use ( node -- def-use )
  29     [ compute-def-use drop def-use get ] with-scope ;
  30
  31 : (node-def-use) ( node -- )
  32     {
  33         [ dup in-d>> uses-values ]
  34         [ dup in-r>> uses-values ]
  35         [ out-d>>    defs-values ]
  36         [ out-r>>    defs-values ]
  37     } cleave ;
  38
  39 M: object node-def-use (node-def-use) ;
  40
  41 ! nodes that don't use their values directly
  42 UNION: #passthru
  43     #shuffle #>r #r> #call-label #merge #values #entry #declare ;
  44
  45 M: #passthru node-def-use drop ;
  46
  47 M: #return node-def-use
  48     #! Values returned by local labels can be killed.
  49     dup param>> [ drop ] [ (node-def-use) ] if ;
  50
  51 ! nodes that don't use their values directly
  52 UNION: #killable
  53     #push #passthru ;
  54
  55 : purge-invariants ( stacks -- seq )
  56     #! Output a sequence of values which are not present in the
  57     #! same position in each sequence of the stacks sequence.
  58     unify-lengths flip [ all-eq? not ] filter concat ;
  59
  60 M: #label node-def-use
  61     [
  62         dup in-d>> ,
  63         dup node-child out-d>> ,
  64         dup calls>> [ in-d>> , ] each
  65     ] { } make purge-invariants uses-values ;
  66
  67 : branch-def-use ( #branch -- )
  68     active-children [ in-d>> ] map
  69     purge-invariants t swap uses-values ;
  70
  71 M: #branch node-def-use
  72     #! This assumes that the last element of each branch is a
  73     #! #values node.
  74     dup branch-def-use (node-def-use) ;
  75
  76 : compute-dead-literals ( -- values )
  77     def-use get [ >r value? r> empty? and ] assoc-filter ;
  78
  79 DEFER: kill-nodes
  80 SYMBOL: dead-literals
  81
  82 GENERIC: kill-node* ( node -- node/t )
  83
  84 M: node kill-node* drop t ;
  85
  86 : prune-if ( node quot -- successor/t )
  87     over >r call [ r> node-successor ] [ r> drop t ] if ;
  88     inline
  89
  90 M: #shuffle kill-node*
  91     [ [ in-d>> empty? ] [ out-d>> empty? ] bi and ] prune-if ;
  92
  93 M: #push kill-node*
  94     [ out-d>> empty? ] prune-if ;
  95
  96 M: #>r kill-node*
  97     [ in-d>> empty? ] prune-if ;
  98
  99 M: #r> kill-node*
 100     [ in-r>> empty? ] prune-if ;
 101
 102 : kill-node ( node -- node )
 103     dup [
 104         dup [ dead-literals get swap remove-all ] modify-values
 105         dup kill-node* dup t eq? [
 106             drop dup [ kill-nodes ] map-children
 107         ] [
 108             nip kill-node
 109         ] if
 110     ] when ;
 111
 112 : kill-nodes ( node -- newnode )
 113     [ kill-node ] transform-nodes ;
 114
 115 : kill-values ( node -- new-node )
 116     #! Remove literals which are not actually used anywhere.
 117     compute-dead-literals dup assoc-empty? [ drop ] [
 118         dead-literals [ kill-nodes ] with-variable
 119     ] if ;
 120
 121 : sole-consumer ( #call -- node/f )
 122     out-d>> first used-by
 123     dup length 1 = [ first ] [ drop f ] if ;
 124
 125 : splice-def-use ( node -- )
 126     #! As a first approximation, we take all the values used
 127     #! by the set of new nodes, and push a 't' on their
 128     #! def-use list here. We could perform a full graph
 129     #! substitution, but we don't need to, because the next
 130     #! optimizer iteration will do that. We just need a minimal
 131     #! degree of accuracy; the new values should be marked as
 132     #! having _some_ usage, so that flushing doesn't erronously
 133     #! flush them away.
 134     nest-def-use keys def-use get [ t -rot push-at ] curry each ;