diff --git a/basis/compiler/cfg/ssa/destruction/copies/copies.factor b/basis/compiler/cfg/ssa/destruction/copies/copies.factor index 063704e0f6..177793f1a1 100644 --- a/basis/compiler/cfg/ssa/destruction/copies/copies.factor +++ b/basis/compiler/cfg/ssa/destruction/copies/copies.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs hashtables fry kernel make namespaces +USING: accessors assocs hashtables fry kernel make namespaces sets sequences compiler.cfg.ssa.destruction.state compiler.cfg.parallel-copy ; IN: compiler.cfg.ssa.destruction.copies @@ -9,7 +9,7 @@ ERROR: bad-copy ; : compute-copies ( assoc -- assoc' ) dup assoc-size [ '[ - [ + prune [ 2dup eq? [ 2drop ] [ _ 2dup key? [ bad-copy ] [ set-at ] if diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor index c650782582..194e7e6d8f 100644 --- a/basis/compiler/cfg/ssa/destruction/destruction.factor +++ b/basis/compiler/cfg/ssa/destruction/destruction.factor @@ -29,7 +29,7 @@ SYMBOL: seen :: visit-renaming ( dst assoc src bb -- ) src seen get key? [ - src dst bb waiting-for push-at + src dst bb add-waiting src assoc delete-at ] [ src seen get conjoin ] if ; diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor index ce2aa1c5d7..f3f4dfd2cc 100644 --- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor +++ b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor @@ -46,7 +46,7 @@ SYMBOLS: phi-union unioned-blocks ; 2nip processed-name ; :: trivial-interference ( bb src dst -- ) - dst src bb waiting-for push-at + dst src bb add-waiting src used-by-another get push ; :: add-to-renaming-set ( bb src dst -- ) diff --git a/basis/compiler/cfg/ssa/destruction/state/state.factor b/basis/compiler/cfg/ssa/destruction/state/state.factor index 30e69521b9..a10ac2c8de 100644 --- a/basis/compiler/cfg/ssa/destruction/state/state.factor +++ b/basis/compiler/cfg/ssa/destruction/state/state.factor @@ -14,3 +14,5 @@ SYMBOLS: processed-names waiting used-by-another renaming-sets ; : processed-name ( vreg -- ) processed-names get conjoin ; : waiting-for ( bb -- assoc ) waiting get [ drop H{ } clone ] cache ; + +: add-waiting ( dst src bb -- ) waiting-for push-at ; \ No newline at end of file diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index f1d17fe4a2..40f64cf4f1 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -2,7 +2,7 @@ USING: generalizations accessors arrays compiler kernel kernel.private math hashtables.private math.private namespaces sequences tools.test namespaces.private slots.private sequences.private byte-arrays alien alien.accessors layouts words definitions compiler.units io -combinators vectors grouping make alien.c-types ; +combinators vectors grouping make alien.c-types combinators.short-circuit ; QUALIFIED: namespaces.private IN: compiler.tests.codegen @@ -345,4 +345,17 @@ cell 4 = [ dup [ \ vector eq? ] [ drop f ] if over rot [ drop ] [ nip ] if ] compile-call -] unit-test \ No newline at end of file +] unit-test + +! Coalesing bug reduced from sequence-parser:take-sequence +: coalescing-bug-1 ( str a b c -- a b c d ) + 3dup { + [ 2drop 0 < ] + [ [ drop ] 2dip length > ] + [ drop > ] + } 3|| [ 3drop f ] [ slice boa ] if swap [ [ length ] bi@ ] 2keep ; + +[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } -10 3 "hello" coalescing-bug-1 ] unit-test +[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 0 5 "hello" coalescing-bug-1 ] unit-test +[ 0 3 f { 1 2 3 } ] [ { 1 2 3 } 3 2 "hello" coalescing-bug-1 ] unit-test +[ 2 3 T{ slice f "hello" 1 3 } { 1 2 3 } ] [ { 1 2 3 } 1 3 "hello" coalescing-bug-1 ] unit-test \ No newline at end of file