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

compiler: cleaner use of sets.

db4
John Benediktsson 2013-03-10 17:21:27 -07:00
parent 7c39f8134b
commit b8097f9221
4 changed files with 18 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/compiler/cfg/branch-splitting/branch-splitting.factor
View File

@ -85,10 +85,8 @@ SYMBOL: worklist
SYMBOL: visited SYMBOL: visited
: add-to-worklist ( bb -- ) : add-to-worklist ( bb -- )
dup visited get in? [ drop ] [ dup visited get ?adjoin
[ visited get adjoin ] [ worklist get push-front ] [ drop ] if ;
[ worklist get push-front ] bi
] if ;
: init-worklist ( cfg -- ) : init-worklist ( cfg -- )
<dlist> worklist set <dlist> worklist set

7
basis/compiler/cfg/linearization/linearization.factor
View File

@ -59,12 +59,11 @@ SYMBOLS: work-list loop-heads visited ;
successors>> <reversed> [ loop-nesting-at ] sort-with ; successors>> <reversed> [ loop-nesting-at ] sort-with ;
: process-block ( bb -- ) : process-block ( bb -- )
dup visited? [ drop ] [ dup visited get ?adjoin [
[ , ] [ , ]
[ visited get adjoin ]
[ sorted-successors [ process-successor ] each ] [ sorted-successors [ process-successor ] each ]
tri bi
] if ; ] [ drop ] if ;
: (linearization-order) ( cfg -- bbs ) : (linearization-order) ( cfg -- bbs )
init-linearization-order init-linearization-order

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

@ -31,25 +31,22 @@ DEFER: find-loop-headers
if ; if ;
: find-loop-headers ( bb -- ) : find-loop-headers ( bb -- )
dup visited get in? [ drop ] [ dup visited get ?adjoin [
{ active get
[ visited get adjoin ] [ adjoin ]
[ active get adjoin ] [ [ dup successors>> ] dip '[ _ visit-edge ] with each ]
[ dup successors>> active get '[ _ visit-edge ] with each ] [ delete ]
[ active get delete ] 2tri
} cleave ] [ drop ] if ;
] if ;
SYMBOL: work-list SYMBOL: work-list
: process-loop-block ( bb loop -- ) : process-loop-block ( bb loop -- )
2dup blocks>> in? [ 2drop ] [ 2dup blocks>> ?adjoin [
[ blocks>> adjoin ] [ 2dup header>> eq? [ 2drop ] [
2dup header>> eq? [ 2drop ] [ drop predecessors>> work-list get push-all-front
drop predecessors>> work-list get push-all-front ] if
] if ] [ 2drop ] if ;
] 2bi
] if ;
: process-loop-ends ( loop -- ) : process-loop-ends ( loop -- )
[ ends>> members <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep [ ends>> members <dlist> [ push-all-front ] [ work-list set ] [ ] tri ] keep

3
basis/compiler/tree/def-use/simplified/simplified.factor
View File

@ -15,8 +15,7 @@ TUPLE: real-usage value node ;
SYMBOLS: visited accum ; SYMBOLS: visited accum ;
: if-not-visited ( value quot -- ) : if-not-visited ( value quot -- )
over visited get in? over visited get ?adjoin [ call ] [ 2drop ] if ; inline
[ 2drop ] [ over visited get adjoin call ] if ; inline
: with-simplified-def-use ( quot -- real-usages ) : with-simplified-def-use ( quot -- real-usages )
[ [