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

Revert "compiler.cfg.ssa.construction.tdmsc: more use of ?adjoin." 

This reverts commit 6bf55a6d89.
db4
John Benediktsson 2013-03-23 18:39:15 -07:00
parent 3f1a426210
commit 15f9ba2763
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -32,9 +32,10 @@ SYMBOLS: visited merge-sets levels again? ;
: level ( bb -- n ) levels get at ; inline : level ( bb -- n ) levels get at ; inline
: update-merge-set ( tmp to -- ) : update-merge-set ( tmp to -- )
[ merge-sets get ] dip over '[ [ merge-sets get ] dip
'[
_ _
[ _ at union ] [ merge-sets get at union ]
[ number>> over adjoin ] [ number>> over adjoin ]
bi bi
] change-at ; ] change-at ;
@ -49,18 +50,23 @@ SYMBOLS: visited merge-sets levels again? ;
[ [ predecessors>> ] keep ] dip [ [ predecessors>> ] keep ] dip
'[ _ 2dup j-edge? _ [ 2drop ] if ] each ; inline '[ _ 2dup j-edge? _ [ 2drop ] if ] each ; inline
: visited? ( pair -- ? ) visited get in? ;
: consistent? ( snode lnode -- ? ) : consistent? ( snode lnode -- ? )
[ merge-sets get at ] bi@ subset? ; [ merge-sets get at ] bi@ subset? ;
: (process-edge) ( from to -- ) : (process-edge) ( from to -- )
f walk [ f walk [
2dup 2array visited get ?adjoin 2dup 2array visited? [
[ 2drop ] [ consistent? [ again? on ] unless ] if consistent? [ again? on ] unless
] [ 2drop ] if
] each-incoming-j-edge ; ] each-incoming-j-edge ;
: process-edge ( from to -- ) : process-edge ( from to -- )
2dup 2array visited get ?adjoin 2dup 2array dup visited? [ 3drop ] [
[ (process-edge) ] [ 2drop ] if ; visited get adjoin
(process-edge)
] if ;
: process-block ( bb -- ) : process-block ( bb -- )
[ process-edge ] each-incoming-j-edge ; [ process-edge ] each-incoming-j-edge ;