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: accessors compiler.tree compiler.tree.def-use kernel
   4 namespaces sequences sets stack-checker.branches ;
   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 ?adjoin [ call ] [ 2drop ] if ; inline
  18
  19 : with-simplified-def-use ( quot -- real-usages )
  20     [
  21         HS{ } clone visited namespaces:set
  22         HS{ } clone accum namespaces:set
  23         call
  24         accum get members
  25     ] with-scope ; inline
  26
  27 PRIVATE>
  28
  29 ! Def
  30 GENERIC: actually-defined-by* ( value node -- )
  31
  32 : (actually-defined-by) ( value -- )
  33     [ dup defined-by actually-defined-by* ] if-not-visited ;
  34
  35 M: #renaming actually-defined-by*
  36     inputs/outputs swap [ index ] dip nth (actually-defined-by) ;
  37
  38 M: #call-recursive actually-defined-by*
  39     [ out-d>> index ] [ label>> return>> in-d>> nth ] bi
  40     (actually-defined-by) ;
  41
  42 M: #enter-recursive actually-defined-by*
  43     [ out-d>> index ] keep
  44     [ in-d>> nth (actually-defined-by) ]
  45     [ label>> calls>> [ node>> in-d>> nth (actually-defined-by) ] with each ] 2bi ;
  46
  47 M: #phi actually-defined-by*
  48     [ out-d>> index ] [ phi-in-d>> ] bi
  49     [
  50         nth dup +bottom+ eq?
  51         [ drop ] [ (actually-defined-by) ] if
  52     ] with each ;
  53
  54 M: node actually-defined-by*
  55     real-usage boa accum get adjoin ;
  56
  57 : actually-defined-by ( value -- real-usages )
  58     [ (actually-defined-by) ] with-simplified-def-use ;
  59
  60 ! Use
  61 GENERIC: actually-used-by* ( value node -- )
  62
  63 : (actually-used-by) ( value -- )
  64     [ dup used-by [ actually-used-by* ] with each ] if-not-visited ;
  65
  66 M: #renaming actually-used-by*
  67     inputs/outputs [ indices ] dip nths
  68     [ (actually-used-by) ] each ;
  69
  70 M: #return-recursive actually-used-by*
  71     [ in-d>> index ] keep
  72     [ out-d>> nth (actually-used-by) ]
  73     [ label>> calls>> [ node>> out-d>> nth (actually-used-by) ] with each ] 2bi ;
  74
  75 M: #call-recursive actually-used-by*
  76     [ in-d>> index ] [ label>> enter-out>> nth ] bi
  77     (actually-used-by) ;
  78
  79 M: #enter-recursive actually-used-by*
  80     [ in-d>> index ] [ out-d>> nth ] bi (actually-used-by) ;
  81
  82 M: #phi actually-used-by*
  83     [ phi-in-d>> [ index ] with map-find drop ] [ out-d>> nth ] bi
  84     (actually-used-by) ;
  85
  86 M: #recursive actually-used-by* 2drop ;
  87
  88 M: node actually-used-by*
  89     real-usage boa accum get adjoin ;
  90
  91 : actually-used-by ( value -- real-usages )
  92     [ (actually-used-by) ] with-simplified-def-use ;