From 42230b21a3b76fae48f6fdc0dda61d6f9fd661ec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 02:06:14 -0500
Subject: [PATCH] Add assoc-refine, which takes the intersection of a sequence
 of assocs

---
 core/assocs/assocs-tests.factor | 16 ++++++++++++++++
 core/assocs/assocs.factor       |  3 +++
 2 files changed, 19 insertions(+)

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 75607b0258..3c5ac31d23 100644
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -134,3 +134,19 @@ unit-test
 [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
+
+[ H{ { 1 2 } { 2 3 } } ] [
+    {
+        H{ { 1 3 } }
+        H{ { 2 3 } }
+        H{ { 1 2 } }
+    } assoc-combine
+] unit-test
+
+[ H{ { 1 7 } } ] [
+    {
+        H{ { 1 2 } { 2 4 } { 5 6 } }
+        H{ { 1 3 } { 2 5 } }
+        H{ { 1 7 } { 5 6 } }
+    } assoc-refine
+] unit-test
\ No newline at end of file
diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 62ab9f86ae..8b6809236c 100755
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -129,6 +129,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 : assoc-combine ( seq -- union )
     H{ } clone [ dupd update ] reduce ;
 
+: assoc-refine ( seq -- assoc )
+    [ f ] [ [ ] [ assoc-intersect ] map-reduce ] if-empty ;
+
 : assoc-diff ( assoc1 assoc2 -- diff )
     [ nip key? not ] curry assoc-filter ;