assocs.extras: Add assoc-collapse! and assoc-collapse-as

[factor.git] / extra / assocs / extras / extras.factor

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 44b076817967dc63689f19d8e21c56380b550fe2..7abad29da3f2379d973d3440e589547d32450d86 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -82,6 +82,13 @@ IN: assocs.extras
     [ 2drop f ]
     [ [ unclip-slice H{ } or clone ] [ [ assoc-merge! ] curry ] bi* reduce ] if ; inline
 
+: assoc-collapse! ( assoc seq quot: ( value1 value2 -- new-value ) -- assoc )
+    [ assoc-merge! ] curry each ; inline
+
+: assoc-collapse-as ( seq quot: ( value1 value2 -- new-value ) exemplar -- assoc )
+    pick first assoc-size swap new-assoc
+    -rot assoc-collapse! ; inline
+
 GENERIC: delete-value-at ( value assoc -- )
 
 M: assoc delete-value-at