compiler.cfg.dominance: add algorithm for computing iterated dominance frontiers
parent
89db2e745d
commit
d864214119
|
@ -74,3 +74,25 @@ V{ } 5 test-bb
|
||||||
[ ] [ test-dominance ] unit-test
|
[ ] [ test-dominance ] unit-test
|
||||||
|
|
||||||
[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
|
||||||
|
|
||||||
|
V{ } 0 test-bb
|
||||||
|
V{ } 1 test-bb
|
||||||
|
V{ } 2 test-bb
|
||||||
|
V{ } 3 test-bb
|
||||||
|
V{ } 4 test-bb
|
||||||
|
V{ } 5 test-bb
|
||||||
|
V{ } 6 test-bb
|
||||||
|
|
||||||
|
0 get 1 get 5 get V{ } 2sequence >>successors drop
|
||||||
|
1 get 2 get 3 get V{ } 2sequence >>successors drop
|
||||||
|
2 get 4 get 1vector >>successors drop
|
||||||
|
3 get 4 get 1vector >>successors drop
|
||||||
|
4 get 6 get 1vector >>successors drop
|
||||||
|
5 get 6 get 1vector >>successors drop
|
||||||
|
|
||||||
|
[ ] [ test-dominance ] unit-test
|
||||||
|
|
||||||
|
[ t ] [
|
||||||
|
2 get 3 get 2array iterated-dom-frontier
|
||||||
|
4 get 6 get 2array set=
|
||||||
|
] unit-test
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs combinators sets math fry kernel math.order
|
USING: accessors assocs combinators sets math fry kernel math.order
|
||||||
namespaces sequences sorting compiler.cfg.rpo ;
|
dlists deques namespaces sequences sorting compiler.cfg.rpo ;
|
||||||
IN: compiler.cfg.dominance
|
IN: compiler.cfg.dominance
|
||||||
|
|
||||||
! Reference:
|
! Reference:
|
||||||
|
@ -85,8 +85,31 @@ PRIVATE>
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: compute-dominance ( cfg -- cfg' )
|
: compute-dominance ( cfg -- )
|
||||||
[ compute-dom-parents compute-dom-children ]
|
[ compute-dom-parents compute-dom-children ]
|
||||||
[ compute-dom-frontiers ]
|
[ compute-dom-frontiers ]
|
||||||
[ ]
|
bi ;
|
||||||
tri ;
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
SYMBOLS: work-list visited ;
|
||||||
|
|
||||||
|
: add-to-work-list ( bb -- )
|
||||||
|
dom-frontier work-list get push-all-front ;
|
||||||
|
|
||||||
|
: iterated-dom-frontier-step ( bb -- )
|
||||||
|
dup visited get key? [ drop ] [
|
||||||
|
[ visited get conjoin ]
|
||||||
|
[ add-to-work-list ] bi
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: iterated-dom-frontier ( bbs -- bbs' )
|
||||||
|
[
|
||||||
|
<dlist> work-list set
|
||||||
|
H{ } clone visited set
|
||||||
|
[ add-to-work-list ] each
|
||||||
|
work-list get [ iterated-dom-frontier-step ] slurp-deque
|
||||||
|
visited get keys
|
||||||
|
] with-scope ;
|
Loading…
Reference in New Issue