assocs.extras: Add collect-by-multi and push-at-each

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

diff --git a/extra/assocs/extras/extras.factor b/extra/assocs/extras/extras.factor
index 69a2c3cbce77811544fadc58ee916446fd22f11a..3425b13388831313ccdf170065096469f92594a8 100644 (file)
--- a/extra/assocs/extras/extras.factor
+++ b/extra/assocs/extras/extras.factor
@@ -234,3 +234,14 @@ PRIVATE>
 : histogram-diff ( hashtable1 hashtable2 -- hashtable3 )
     [ neg swap pick at+ ] assoc-each
     [ 0 > ] filter-values ;
+
+: push-at-each ( value keys assoc -- )
+    '[ _ push-at ] with each ; inline
+
+: collect-by-multi! ( ... assoc seq quot: ( ... obj -- ... key ) -- ... assoc )
+    [ keep swap ] curry rot [
+        [ push-at-each ] curry compose each
+    ] keep ; inline
+
+: collect-by-multi ( ... seq quot: ( ... obj -- ... keys ) -- ... assoc )
+    [ H{ } clone ] 2dip collect-by-multi! ; inline