Add assoc-refine, which takes the intersection of a sequence of assocs

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 75607b0258cb317c05168e30031593f03e9061c8..3c5ac31d23e2d94c0a2f31b9202e0b8d10c0db59 100644 (file)
--- 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 62ab9f86ae9711f2285deaad9df9128680cd558c..8b6809236c4368a1301ad215721481f7e386dc4f 100755 (executable)
--- 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 ;