1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs combinators sets math fry kernel math.order
4 dlists deques vectors namespaces sequences sorting locals
5 compiler.cfg.rpo compiler.cfg.predecessors ;
6 IN: compiler.cfg.dominance
10 ! A Simple, Fast Dominance Algorithm
11 ! Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy
12 ! http://www.cs.rice.edu/~keith/EMBED/dom.pdf
14 ! Also, a nice overview is given in these lecture notes:
15 ! http://llvm.cs.uiuc.edu/~vadve/CS526/public_html/Notes/4ssa.4up.pdf
24 : dom-parent ( bb -- bb' ) dom-parents get at ;
28 : set-idom ( idom bb -- changed? )
29 dom-parents get maybe-set-at ;
31 : intersect ( finger1 finger2 -- bb )
32 2dup [ number>> ] compare {
33 { +gt+ [ [ dom-parent ] dip intersect ] }
34 { +lt+ [ dom-parent intersect ] }
38 : compute-idom ( bb -- idom )
39 predecessors>> [ dom-parent ] filter
40 [ ] [ intersect ] map-reduce ;
42 : iterate ( rpo -- changed? )
43 [ [ compute-idom ] keep set-idom ] map [ ] any? ;
45 : compute-dom-parents ( cfg -- )
46 H{ } clone dom-parents set
48 unclip dup set-idom drop '[ _ iterate ] loop ;
50 ! Maps bb -> {bb' | idom(bb') = bb}
55 : dom-children ( bb -- seq ) dom-childrens get at ;
59 : compute-dom-children ( -- )
60 dom-parents get H{ } clone
61 [ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
64 SYMBOLS: preorder maxpreorder ;
68 : pre-of ( bb -- n ) [ preorder get at ] [ -1/0. ] if* ;
70 : maxpre-of ( bb -- n ) [ maxpreorder get at ] [ 1/0. ] if* ;
74 : (compute-dfs) ( n bb -- n )
76 [ dupd preorder get set-at ]
77 [ dom-children [ (compute-dfs) ] each ]
78 [ dupd maxpreorder get set-at ]
81 : compute-dfs ( cfg -- )
82 H{ } clone preorder set
83 H{ } clone maxpreorder set
84 [ 0 ] dip entry>> (compute-dfs) drop ;
86 : compute-dominance ( cfg -- cfg' )
87 [ compute-dom-parents compute-dom-children ] [ compute-dfs ] [ ] tri ;
91 : needs-dominance ( cfg -- cfg' )
93 dup dominance-valid?>> [ compute-dominance t >>dominance-valid? ] unless ;
95 : dominates? ( bb1 bb2 -- ? )
96 swap [ pre-of ] [ [ pre-of ] [ maxpre-of ] bi ] bi* between? ;
98 :: breadth-first-order ( cfg -- bfo )
100 cfg post-order length <vector> :> accum
101 cfg entry>> work-list push-front
104 [ dom-children work-list push-all-front ] bi