diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor index d8fc92aaa6..5fd613c326 100644 --- a/basis/compiler/cfg/loop-detection/loop-detection.factor +++ b/basis/compiler/cfg/loop-detection/loop-detection.factor @@ -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 ; diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor index 711657e8e5..09889c59d8 100644 --- a/basis/compiler/cfg/rpo/rpo.factor +++ b/basis/compiler/cfg/rpo/rpo.factor @@ -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>> [ post-order-traversal ] each ] [ , ] bi - ] if ; + ] if ; inline recursive : number-blocks ( blocks -- ) dup length iota @@ -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 ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 820871ea05..72bbcf4feb 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -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' diff --git a/basis/compiler/tree/def-use/simplified/simplified.factor b/basis/compiler/tree/def-use/simplified/simplified.factor index 0061e8cffb..b93c013dfa 100644 --- a/basis/compiler/tree/def-use/simplified/simplified.factor +++ b/basis/compiler/tree/def-use/simplified/simplified.factor @@ -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 ;