1 ! Copyright (C) 2008 Slava Pestov.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators compiler.tree
4 compiler.tree.combinators
5 compiler.tree.escape-analysis.allocations
6 compiler.tree.escape-analysis.branches
7 compiler.tree.escape-analysis.nodes compiler.tree.recursive
8 disjoint-sets fry kernel namespaces sequences ;
9 IN: compiler.tree.escape-analysis.recursive
11 : congruent? ( alloc1 alloc2 -- ? )
13 { [ 2dup [ f eq? ] either? ] [ eq? ] }
14 { [ 2dup [ t eq? ] either? ] [ eq? ] }
15 { [ 2dup [ length ] bi@ = not ] [ 2drop f ] }
16 [ [ [ allocation ] bi@ congruent? ] 2all? ]
19 : check-fixed-point ( node alloc1 alloc2 -- )
20 [ congruent? ] 2all? [ drop ] [ label>> f >>fixed-point drop ] if ;
22 : node-input-allocations ( node -- allocations )
23 in-d>> [ allocation ] map ;
25 : node-output-allocations ( node -- allocations )
26 out-d>> [ allocation ] map ;
28 : recursive-stacks ( #enter-recursive -- stacks )
30 escaping-values get '[ [ _ disjoint-set-member? ] all? ] filter
33 : analyze-recursive-phi ( #enter-recursive -- )
34 [ ] [ recursive-stacks ] [ out-d>> ] tri
35 [ [ merge-values ] 2each ]
37 [ (merge-allocations) ] dip
38 [ [ allocation ] map check-fixed-point ]
39 [ record-allocations ]
43 M: #recursive escape-analysis* ( #recursive -- )
44 [ label>> return>> in-d>> introduce-values ]
48 [ first out-d>> introduce-values ]
49 [ first analyze-recursive-phi ]
55 M: #enter-recursive escape-analysis* ( #enter-recursive -- )
56 ! Handled by #recursive
59 M: #call-recursive escape-analysis* ( #call-label -- )
60 [ ] [ label>> return>> ] [ node-output-allocations ] tri
61 [ [ node-input-allocations ] dip check-fixed-point ]
62 [ drop swap [ in-d>> ] [ out-d>> ] bi* copy-values ]
65 M: #return-recursive escape-analysis* ( #return-recursive -- )
68 [ in-d>> ] [ label>> calls>> ] bi
69 [ node>> out-d>> escaping-values get '[ _ equate ] 2each ] with each