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

View File

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

View File

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

View File

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

View File

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