compiler: use hash-sets to track visited sets.

db4
John Benediktsson 2013-03-08 11:04:47 -08:00
parent f06bfef276
commit bf35114fec
4 changed files with 25 additions and 29 deletions

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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'

View File

@ -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 ;