compiler: cleaner use of sets.
parent
7c39f8134b
commit
b8097f9221
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue