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

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs compiler.tree compiler.tree.combinators
   4 fry kernel namespaces sequences stack-checker.branches ;
   5 FROM: namespaces => set ;
   6 QUALIFIED: sets
   7 IN: compiler.tree.def-use
   8
   9 SYMBOL: def-use
  10
  11 TUPLE: definition value node uses ;
  12
  13 : <definition> ( node value -- definition )
  14     definition new
  15         swap >>value
  16         swap >>node
  17         V{ } clone >>uses ;
  18
  19 ERROR: no-def-error value ;
  20
  21 : (def-of) ( value def-use -- definition )
  22     ?at [ no-def-error ] unless ; inline
  23
  24 : def-of ( value -- definition )
  25     def-use get (def-of) ;
  26
  27 ERROR: multiple-defs-error ;
  28
  29 : (def-value) ( node value def-use -- )
  30     2dup key? [
  31         multiple-defs-error
  32     ] [
  33         [ [ <definition> ] keep ] dip set-at
  34     ] if ; inline
  35
  36 : def-value ( node value -- )
  37     def-use get (def-value) ;
  38
  39 : def-values ( node values -- )
  40     def-use get '[ _ (def-value) ] with each ;
  41
  42 : used-by ( value -- nodes ) def-of uses>> ;
  43
  44 : use-value ( node value -- ) used-by push ;
  45
  46 : use-values ( node values -- )
  47     def-use get '[ _ (def-of) uses>> push ] with each ;
  48
  49 : defined-by ( value -- node ) def-of node>> ;
  50
  51 GENERIC: node-uses-values ( node -- values )
  52
  53 M: #introduce node-uses-values drop f ;
  54 M: #push node-uses-values drop f ;
  55 M: #phi node-uses-values phi-in-d>> concat remove-bottom sets:members ;
  56 M: #declare node-uses-values drop f ;
  57 M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
  58 M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
  59 M: #alien-callback node-uses-values drop f ;
  60 M: node node-uses-values in-d>> ;
  61
  62 GENERIC: node-defs-values ( node -- values )
  63
  64 M: #shuffle node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
  65 M: #branch node-defs-values drop f ;
  66 M: #declare node-defs-values drop f ;
  67 M: #return node-defs-values drop f ;
  68 M: #recursive node-defs-values drop f ;
  69 M: #terminate node-defs-values drop f ;
  70 M: #alien-callback node-defs-values drop f ;
  71 M: node node-defs-values out-d>> ;
  72
  73 : node-def-use ( node -- )
  74     [ dup node-uses-values use-values ]
  75     [ dup node-defs-values def-values ] bi ;
  76
  77 : compute-def-use ( node -- node )
  78     H{ } clone def-use set
  79     dup [ node-def-use ] each-node ;