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: arrays namespaces sequences kernel generic assocs
   4 classes vectors accessors combinators sets
   5 stack-checker.state
   6 stack-checker.branches
   7 compiler.tree
   8 compiler.tree.combinators ;
   9 IN: compiler.tree.def-use
  10
  11 SYMBOL: def-use
  12
  13 TUPLE: definition value node uses ;
  14
  15 : <definition> ( node value -- definition )
  16     definition new
  17         swap >>value
  18         swap >>node
  19         V{ } clone >>uses ;
  20
  21 ERROR: no-def-error value ;
  22
  23 : def-of ( value -- definition )
  24     def-use get ?at [ no-def-error ] unless ;
  25
  26 ERROR: multiple-defs-error ;
  27
  28 : def-value ( node value -- )
  29     def-use get 2dup key? [
  30         multiple-defs-error
  31     ] [
  32         [ [ <definition> ] keep ] dip set-at
  33     ] if ;
  34
  35 : used-by ( value -- nodes ) def-of uses>> ;
  36
  37 : use-value ( node value -- ) used-by push ;
  38
  39 : defined-by ( value -- node ) def-of node>> ;
  40
  41 GENERIC: node-uses-values ( node -- values )
  42
  43 M: #introduce node-uses-values drop f ;
  44 M: #push node-uses-values drop f ;
  45 M: #phi node-uses-values phi-in-d>> concat remove-bottom prune ;
  46 M: #declare node-uses-values drop f ;
  47 M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
  48 M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
  49 M: #alien-callback node-uses-values drop f ;
  50 M: node node-uses-values in-d>> ;
  51
  52 GENERIC: node-defs-values ( node -- values )
  53
  54 M: #shuffle node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
  55 M: #branch node-defs-values drop f ;
  56 M: #declare node-defs-values drop f ;
  57 M: #return node-defs-values drop f ;
  58 M: #recursive node-defs-values drop f ;
  59 M: #terminate node-defs-values drop f ;
  60 M: #alien-callback node-defs-values drop f ;
  61 M: node node-defs-values out-d>> ;
  62
  63 : node-def-use ( node -- )
  64     [ dup node-uses-values [ use-value ] with each ]
  65     [ dup node-defs-values [ def-value ] with each ] bi ;
  66
  67 : compute-def-use ( node -- node )
  68     H{ } clone def-use set
  69     dup [ node-def-use ] each-node ;