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 ;
6 IN: compiler.tree.def-use
10 TUPLE: definition value node uses ;
12 : <definition> ( node value -- definition )
18 ERROR: no-def-error value ;
20 : (def-of) ( value def-use -- definition )
21 ?at [ throw-no-def-error ] unless ; inline
23 : def-of ( value -- definition )
24 def-use get (def-of) ;
26 ERROR: multiple-defs-error ;
28 : (def-value) ( node value def-use -- )
30 throw-multiple-defs-error
32 [ [ <definition> ] keep ] dip set-at
35 : def-value ( node value -- )
36 def-use get (def-value) ;
38 : def-values ( node values -- )
39 def-use get '[ _ (def-value) ] with each ;
41 : used-by ( value -- nodes ) def-of uses>> ;
43 : use-value ( node value -- ) used-by push ;
45 : use-values ( node values -- )
46 def-use get '[ _ (def-of) uses>> push ] with each ;
48 : defined-by ( value -- node ) def-of node>> ;
50 GENERIC: node-uses-values ( node -- values )
52 M: #introduce node-uses-values drop f ;
53 M: #push node-uses-values drop f ;
54 M: #phi node-uses-values phi-in-d>> concat remove-bottom sets:members ;
55 M: #declare node-uses-values drop f ;
56 M: #terminate node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
57 M: #shuffle node-uses-values [ in-d>> ] [ in-r>> ] bi append ;
58 M: #alien-callback node-uses-values drop f ;
59 M: node node-uses-values in-d>> ;
61 GENERIC: node-defs-values ( node -- values )
63 M: #shuffle node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
64 M: #branch node-defs-values drop f ;
65 M: #declare node-defs-values drop f ;
66 M: #return node-defs-values drop f ;
67 M: #recursive node-defs-values drop f ;
68 M: #terminate node-defs-values drop f ;
69 M: #alien-callback node-defs-values drop f ;
70 M: node node-defs-values out-d>> ;
72 : node-def-use ( node -- )
73 [ dup node-uses-values use-values ]
74 [ dup node-defs-values def-values ] bi ;
76 : compute-def-use ( node -- node )
77 H{ } clone def-use set
78 dup [ node-def-use ] each-node ;