compiler: use hash-sets to track visited sets.
parent
f06bfef276
commit
bf35114fec
|
@ -27,18 +27,18 @@ SYMBOLS: visited active ;
|
|||
DEFER: find-loop-headers
|
||||
|
||||
: visit-edge ( from to -- )
|
||||
dup active get key?
|
||||
dup active get in?
|
||||
[ record-back-edge ]
|
||||
[ nip find-loop-headers ]
|
||||
if ;
|
||||
|
||||
: find-loop-headers ( bb -- )
|
||||
dup visited get key? [ drop ] [
|
||||
dup visited get in? [ drop ] [
|
||||
{
|
||||
[ visited get conjoin ]
|
||||
[ active get conjoin ]
|
||||
[ visited get adjoin ]
|
||||
[ active get adjoin ]
|
||||
[ dup successors>> [ visit-edge ] with each ]
|
||||
[ active get delete-at ]
|
||||
[ active get delete ]
|
||||
} cleave
|
||||
] if ;
|
||||
|
||||
|
@ -70,8 +70,8 @@ SYMBOL: loop-nesting
|
|||
: detect-loops ( cfg -- cfg' )
|
||||
needs-predecessors
|
||||
H{ } clone loops set
|
||||
H{ } clone visited set
|
||||
H{ } clone active set
|
||||
HS{ } clone visited set
|
||||
HS{ } clone active set
|
||||
H{ } clone loop-nesting set
|
||||
dup entry>> find-loop-headers process-loop-headers compute-loop-nesting ;
|
||||
|
||||
|
|
|
@ -5,16 +5,14 @@ assocs fry compiler.cfg compiler.cfg.instructions ;
|
|||
FROM: namespaces => set ;
|
||||
IN: compiler.cfg.rpo
|
||||
|
||||
SYMBOL: visited
|
||||
|
||||
: post-order-traversal ( bb -- )
|
||||
dup visited get key? [ drop ] [
|
||||
dup visited get conjoin
|
||||
: post-order-traversal ( visited bb -- visited' )
|
||||
dup pick in? [ drop ] [
|
||||
dup pick adjoin
|
||||
[
|
||||
successors>> <reversed>
|
||||
[ post-order-traversal ] each
|
||||
] [ , ] bi
|
||||
] if ;
|
||||
] if ; inline recursive
|
||||
|
||||
: number-blocks ( blocks -- )
|
||||
dup length iota <reversed>
|
||||
|
@ -23,8 +21,8 @@ SYMBOL: visited
|
|||
: post-order ( cfg -- blocks )
|
||||
dup post-order>> [ ] [
|
||||
[
|
||||
H{ } clone visited set
|
||||
dup entry>> post-order-traversal
|
||||
HS{ } clone over entry>>
|
||||
post-order-traversal drop
|
||||
] { } make dup number-blocks
|
||||
>>post-order post-order>>
|
||||
] ?if ;
|
||||
|
|
|
@ -18,18 +18,16 @@ IN: compiler.cfg.utilities
|
|||
[ first ##branch? ]
|
||||
} 1&& ;
|
||||
|
||||
SYMBOL: visited
|
||||
|
||||
: (skip-empty-blocks) ( bb -- bb' )
|
||||
dup visited get key? [
|
||||
: (skip-empty-blocks) ( visited bb -- visited' bb' )
|
||||
dup pick in? [
|
||||
dup empty-block? [
|
||||
dup visited get conjoin
|
||||
dup pick adjoin
|
||||
successors>> first (skip-empty-blocks)
|
||||
] when
|
||||
] unless ;
|
||||
] unless ; inline recursive
|
||||
|
||||
: skip-empty-blocks ( bb -- bb' )
|
||||
H{ } clone visited [ (skip-empty-blocks) ] with-variable ;
|
||||
[ HS{ } clone ] dip (skip-empty-blocks) nip ;
|
||||
|
||||
:: update-predecessors ( from to bb -- )
|
||||
! Whenever 'from' appears in the list of predecessors of 'to'
|
||||
|
|
|
@ -15,15 +15,15 @@ TUPLE: real-usage value node ;
|
|||
SYMBOLS: visited accum ;
|
||||
|
||||
: if-not-visited ( value quot -- )
|
||||
over visited get key?
|
||||
[ 2drop ] [ over visited get conjoin call ] if ; inline
|
||||
over visited get in?
|
||||
[ 2drop ] [ over visited get adjoin call ] if ; inline
|
||||
|
||||
: with-simplified-def-use ( quot -- real-usages )
|
||||
[
|
||||
H{ } clone visited set
|
||||
H{ } clone accum set
|
||||
HS{ } clone visited set
|
||||
HS{ } clone accum set
|
||||
call
|
||||
accum get keys
|
||||
accum get members
|
||||
] with-scope ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
@ -54,7 +54,7 @@ M: #phi actually-defined-by*
|
|||
] with each ;
|
||||
|
||||
M: node actually-defined-by*
|
||||
real-usage boa accum get conjoin ;
|
||||
real-usage boa accum get adjoin ;
|
||||
|
||||
: actually-defined-by ( value -- real-usages )
|
||||
[ (actually-defined-by) ] with-simplified-def-use ;
|
||||
|
@ -88,7 +88,7 @@ M: #phi actually-used-by*
|
|||
M: #recursive actually-used-by* 2drop ;
|
||||
|
||||
M: node actually-used-by*
|
||||
real-usage boa accum get conjoin ;
|
||||
real-usage boa accum get adjoin ;
|
||||
|
||||
: actually-used-by ( value -- real-usages )
|
||||
[ (actually-used-by) ] with-simplified-def-use ;
|
||||
|
|
Loading…
Reference in New Issue