compiler.cfg.ssa.destruction: fix bug in renaming triggered by sequence-parser:take-sequence

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 <hashtable> [
         '[
-            [
+            prune [
                 2dup eq? [ 2drop ] [
                     _ 2dup key?
                     [ bad-copy ] [ set-at ] if

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 ;
 

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 -- )

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 ;

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
+] 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