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

   1 ! Copyright (C) 2004, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: optimizer.def-use
   4 USING: namespaces assocs sequences inference.dataflow
   5 inference.backend kernel generic assocs classes vectors ;
   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 ] change-at ] curry* 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 -- )
  25     H{ } clone def-use set [ node-def-use ] each-node ;
  26
  27 : nest-def-use ( node -- def-use )
  28     [ compute-def-use def-use get ] with-scope ;
  29
  30 : (node-def-use) ( node -- )
  31     dup dup node-in-d uses-values
  32     dup dup node-in-r uses-values
  33     dup node-out-d defs-values
  34     node-out-r defs-values ;
  35
  36 M: object node-def-use (node-def-use) ;
  37
  38 ! nodes that don't use their values directly
  39 UNION: #passthru
  40     #shuffle #>r #r> #call-label #merge #values #entry #declare ;
  41
  42 M: #passthru node-def-use drop ;
  43
  44 M: #return node-def-use
  45     #! Values returned by local labels can be killed.
  46     dup node-param [ drop ] [ (node-def-use) ] if ;
  47
  48 ! nodes that don't use their values directly
  49 UNION: #killable
  50     #push #passthru ;
  51
  52 : purge-invariants ( stacks -- seq )
  53     #! Output a sequence of values which are not present in the
  54     #! same position in each sequence of the stacks sequence.
  55     unify-lengths flip [ all-eq? not ] subset concat ;
  56
  57 M: #label node-def-use
  58     [
  59         dup node-in-d ,
  60         dup node-child node-out-d ,
  61         dup collect-recursion [ node-in-d , ] each
  62     ] { } make purge-invariants uses-values ;
  63
  64 : branch-def-use ( #branch -- )
  65     active-children [ node-in-d ] map
  66     purge-invariants t swap uses-values ;
  67
  68 M: #branch node-def-use
  69     #! This assumes that the last element of each branch is a
  70     #! #values node.
  71     dup branch-def-use (node-def-use) ;
  72
  73 : dead-literals ( -- values )
  74     def-use get [ >r value? r> empty? and ] assoc-subset ;
  75
  76 : kill-node* ( node values -- )
  77     [ swap remove-all ] curry modify-values ;
  78
  79 : kill-node ( node values -- )
  80     dup assoc-empty?
  81     [ 2drop ] [ [ kill-node* ] curry each-node ] if ;
  82
  83 : kill-values ( node -- )
  84     #! Remove literals which are not actually used anywhere.
  85     dead-literals kill-node ;
  86
  87 : sole-consumer ( #call -- node/f )
  88     node-out-d first used-by
  89     dup length 1 = [ first ] [ drop f ] if ;