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

compiler.cfg.loop-detection: more use of hash-sets.

db4
John Benediktsson 2013-03-08 12:38:50 -08:00
parent ff9af6423f
commit 262a46a3f4
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/compiler/cfg/loop-detection/loop-detection.factor
View File

@ -12,7 +12,7 @@ SYMBOL: loops
<PRIVATE <PRIVATE
: <natural-loop> ( header index -- loop ) : <natural-loop> ( header index -- loop )
H{ } clone H{ } clone natural-loop boa ; HS{ } clone H{ } clone natural-loop boa ;
: lookup-header ( header -- loop ) : lookup-header ( header -- loop )
loops get [ loops get [
@ -22,12 +22,12 @@ SYMBOL: loops
SYMBOLS: visited active ; SYMBOLS: visited active ;
: record-back-edge ( from to -- ) : record-back-edge ( from to -- )
lookup-header ends>> conjoin ; lookup-header ends>> adjoin ;
DEFER: find-loop-headers DEFER: find-loop-headers
: visit-edge ( from to -- ) : visit-edge ( from to active -- )
dup active get in? dupd in?
[ record-back-edge ] [ record-back-edge ]
[ nip find-loop-headers ] [ nip find-loop-headers ]
if ; if ;
@ -37,7 +37,7 @@ DEFER: find-loop-headers
{ {
[ visited get adjoin ] [ visited get adjoin ]
[ active get adjoin ] [ active get adjoin ]
[ dup successors>> [ visit-edge ] with each ] [ dup successors>> active get '[ _ visit-edge ] with each ]
[ active get delete ] [ active get delete ]
} cleave } cleave
] if ; ] if ;
@ -54,7 +54,7 @@ SYMBOL: work-list
] if ; ] if ;
: process-loop-ends ( loop -- ) : process-loop-ends ( loop -- )
[ ends>> keys <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep [ ends>> members <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep
'[ _ process-loop-block ] slurp-deque ; '[ _ process-loop-block ] slurp-deque ;
: process-loop-headers ( -- ) : process-loop-headers ( -- )