assocs.extras: minor changes to assoc-merge.

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 3af484b2b26ebefb50ba83a3feefda9d6fc679a5..307013918ff436d45d026a101f15e2072fe2558a 100644 (file)
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -1,5 +1,5 @@
 
-USING: assocs.extras kernel tools.test ;
+USING: assocs.extras kernel sequences tools.test ;
 
 IN: assocs.extras
 
@@ -12,11 +12,10 @@ IN: assocs.extras
 
 { H{ { 2 1 } { 4 3 } } } [ H{ { 1 2 } { 3 4 } } assoc-invert ] unit-test
 
-[ H{ } ] [ { } assoc-merge ] unit-test
 [ H{ { "a" V{ 2 5 } } { "b" V{ 3 } } { "c" V{ 10 } } } ]
 [
     { H{ { "a" 2 } { "b" 3 } } H{ { "a" 5 } { "c" 10 } } }
-    assoc-merge
+    [ ] [ assoc-merge ] map-reduce
 ] unit-test
 
 { H{ } } [ H{ { 1 2 } } 2 over delete-value-at ] unit-test

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 737ff3b451d648de81f906bd03a940e2fed62f6e..a145599605daeed244d48b5ab25162ff5918d03f 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -39,11 +39,12 @@ IN: assocs.extras
 : assoc-invert ( assoc -- newassoc )
     dup assoc-invert-as ;
 
-: (assoc-merge) ( assoc1 assoc2 -- assoc1 )
+: assoc-merge! ( assoc1 assoc2 -- assoc1 )
     over [ push-at ] with-assoc assoc-each ;
 
-: assoc-merge ( seq -- merge )
-    H{ } clone [ (assoc-merge) ] reduce ;
+: assoc-merge ( assoc1 assoc2 -- newassoc )
+    [ [ [ assoc-size ] bi@ + ] [ drop ] 2bi new-assoc ] 2keep
+    [ assoc-merge! ] bi@ ;
 
 GENERIC: delete-value-at ( value assoc -- )