From ed73d4c63aa8daa2d74e59e07aea1c226faf1ea3 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Sun, 24 Mar 2013 09:56:55 -0700
Subject: [PATCH] assocs.extras: adding assoc-merge.

---
 extra/assocs/extras/extras-tests.factor | 7 +++++++
 extra/assocs/extras/extras.factor       | 6 ++++++
 2 files changed, 13 insertions(+)

diff --git a/extra/assocs/extras/extras-tests.factor b/extra/assocs/extras/extras-tests.factor
index 951aebe5fb..8cd957e601 100644
--- a/extra/assocs/extras/extras-tests.factor
+++ b/extra/assocs/extras/extras-tests.factor
@@ -15,3 +15,10 @@ IN: assocs.extras
 { H{ { 1 3 } { 2 4 } } } [ { 1 2 } { 3 4 } H{ } zip-as ] unit-test
 
 { 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
+] unit-test
diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 21d0044c51..ffdf53845d 100644
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -43,3 +43,9 @@ IN: assocs.extras
 
 : assoc-invert ( assoc -- newassoc )
     dup assoc-invert-as ;
+
+: (assoc-merge) ( assoc1 assoc2 -- assoc1 )
+    over [ push-at ] with-assoc assoc-each ;
+
+: assoc-merge ( seq -- merge )
+    H{ } clone [ (assoc-merge) ] reduce ;
-- 
2.34.1