basis/compiler/tree/def-use/simplified/simplified.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences kernel fry vectors accessors namespaces assocs sets
   4 stack-checker.branches compiler.tree compiler.tree.def-use ;
   5 IN: compiler.tree.def-use.simplified
   6
   7 ! Simplified def-use follows chains of copies.
   8
   9 ! A 'real' usage is a usage of a value that is not a #renaming.
  10 TUPLE: real-usage value node ;
  11
  12 <PRIVATE
  13
  14 SYMBOLS: visited accum ;
  15
  16 : if-not-visited ( value quot -- )
  17     over visited get key?
  18     [ 2drop ] [ over visited get conjoin call ] if ; inline
  19
  20 : with-simplified-def-use ( quot -- real-usages )
  21     [
  22         H{ } clone visited set
  23         H{ } clone accum set
  24         call
  25         accum get keys
  26     ] with-scope ; inline
  27
  28 PRIVATE>
  29
  30 ! Def
  31 GENERIC: actually-defined-by* ( value node -- )
  32
  33 : (actually-defined-by) ( value -- )
  34     [ dup defined-by actually-defined-by* ] if-not-visited ;
  35
  36 M: #renaming actually-defined-by*
  37     inputs/outputs swap [ index ] dip nth (actually-defined-by) ;
  38
  39 M: #call-recursive actually-defined-by*
  40     [ out-d>> index ] [ label>> return>> in-d>> nth ] bi
  41     (actually-defined-by) ;
  42
  43 M: #enter-recursive actually-defined-by*
  44     [ out-d>> index ] keep
  45     [ in-d>> nth (actually-defined-by) ]
  46     [ label>> calls>> [ node>> in-d>> nth (actually-defined-by) ] with each ] 2bi ;
  47
  48 M: #phi actually-defined-by*
  49     [ out-d>> index ] [ phi-in-d>> ] bi
  50     [
  51         nth dup +bottom+ eq?
  52         [ drop ] [ (actually-defined-by) ] if
  53     ] with each ;
  54
  55 M: node actually-defined-by*
  56     real-usage boa accum get conjoin ;
  57
  58 : actually-defined-by ( value -- real-usages )
  59     [ (actually-defined-by) ] with-simplified-def-use ;
  60
  61 ! Use
  62 GENERIC: actually-used-by* ( value node -- )
  63
  64 : (actually-used-by) ( value -- )
  65     [ dup used-by [ actually-used-by* ] with each ] if-not-visited ;
  66
  67 M: #renaming actually-used-by*
  68     inputs/outputs [ indices ] dip nths
  69     [ (actually-used-by) ] each ;
  70
  71 M: #return-recursive actually-used-by*
  72     [ in-d>> index ] keep
  73     [ out-d>> nth (actually-used-by) ]
  74     [ label>> calls>> [ node>> out-d>> nth (actually-used-by) ] with each ] 2bi ;
  75
  76 M: #call-recursive actually-used-by*
  77     [ in-d>> index ] [ label>> enter-out>> nth ] bi
  78     (actually-used-by) ;
  79
  80 M: #enter-recursive actually-used-by*
  81     [ in-d>> index ] [ out-d>> nth ] bi (actually-used-by) ;
  82
  83 M: #phi actually-used-by*
  84     [ phi-in-d>> [ index ] with map-find drop ] [ out-d>> nth ] bi
  85     (actually-used-by) ;
  86
  87 M: #recursive actually-used-by* 2drop ;
  88
  89 M: node actually-used-by*
  90     real-usage boa accum get conjoin ;
  91
  92 : actually-used-by ( value -- real-usages )
  93     [ (actually-used-by) ] with-simplified-def-use ;