steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Finishing converting compiler.cfg.ssa.construction.tdmsc to new-sets

db4
Daniel Ehrenberg 2010-02-26 13:53:20 -05:00
parent 73a990a4b8
commit a72e2cc96c
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/compiler/cfg/ssa/construction/tdmsc/tdmsc.factor
View File

@ -1,9 +1,9 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs bit-arrays bit-sets fry
hashtables hints kernel locals math namespaces sequences sets
hashtables hints kernel locals math namespaces sequences new-sets
compiler.cfg compiler.cfg.dominance compiler.cfg.rpo ;
QUALIFIED: new-sets
FROM: namespaces => set ;
IN: compiler.cfg.ssa.construction.tdmsc
! TDMSC-I algorithm from "A Practical and Fast Iterative Algorithm for
@ -34,8 +34,8 @@ SYMBOLS: visited merge-sets levels again? ;
[ merge-sets get ] dip
'[
_
[ merge-sets get at new-sets:union ]
[ number>> over new-sets:adjoin ]
[ merge-sets get at union ]
[ number>> over adjoin ]
bi
] change-at ;
@ -49,10 +49,10 @@ SYMBOLS: visited merge-sets levels again? ;
[ [ predecessors>> ] keep ] dip
'[ _ 2dup j-edge? _ [ 2drop ] if ] each ; inline
: visited? ( pair -- ? ) visited get key? ;
: visited? ( pair -- ? ) visited get in? ;
: consistent? ( snode lnode -- ? )
[ merge-sets get at ] bi@ new-sets:subset? ;
[ merge-sets get at ] bi@ subset? ;
: (process-edge) ( from to -- )
f walk [
@ -63,7 +63,7 @@ SYMBOLS: visited merge-sets levels again? ;
: process-edge ( from to -- )
2dup 2array dup visited? [ 3drop ] [
visited get conjoin
visited get adjoin
(process-edge)
] if ;
@ -71,7 +71,7 @@ SYMBOLS: visited merge-sets levels again? ;
[ process-edge ] each-incoming-j-edge ;
: compute-merge-set-step ( bfo -- )
visited get clear-assoc
HS{ } clone visited set
[ process-block ] each ;
: compute-merge-set-loop ( cfg -- )
@ -80,7 +80,7 @@ SYMBOLS: visited merge-sets levels again? ;
loop ;
: (merge-set) ( bbs -- flags rpo )
merge-sets get '[ _ at ] [ new-sets:union ] map-reduce
merge-sets get '[ _ at ] [ union ] map-reduce
cfg get reverse-post-order ; inline
PRIVATE>
@ -88,14 +88,14 @@ PRIVATE>
: compute-merge-sets ( cfg -- )
needs-dominance
H{ } clone visited set
HS{ } clone visited set
[ compute-levels ]
[ init-merge-sets ]
[ compute-merge-set-loop ]
tri ;
: merge-set ( bbs -- bbs' )
(merge-set) [ new-sets:members ] dip nths ;
(merge-set) [ members ] dip nths ;
: merge-set-each ( bbs quot: ( bb -- ) -- )
[ merge-set ] dip each ; inline