assocs: refactor collect-by to use collect-by!

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 4b0347904484ff7f6d57f3723dc262be2e707b89..931da8f2e013b5f2d90bea79deb2fe0f9849c0b8 100644 (file)
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -331,6 +331,17 @@ unit-test
     10 <iota> [ 3 mod ] collect-by
 ] unit-test
 
+{
+    H{
+        { 0 V{ 0 3 6 9 0 3 6 9 } }
+        { 1 V{ 1 4 7 1 4 7 } }
+        { 2 V{ 2 5 8 2 5 8 } }
+    }
+} [
+    10 <iota> [ 3 mod ] collect-by
+    10 <iota> [ 3 mod ] collect-by!
+] unit-test
+
 { H{ { 1 4 } } } [ H{ { 1 2 } } 1 over [ sq ] ?change-at ] unit-test
 { H{ { 1 2 } } } [ H{ { 1 2 } } 2 over [ sq ] ?change-at ] unit-test
 { H{ { 1 3 } } } [ H{ { 1 2 } } 3 1 pick [ drop dup ] ?change-at drop ] unit-test

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index bb9fd94c38cd201c70875509ac170c5530feb3e6..fdfacb8fcce7e699b2aed64bd1d8dec5383a7a24 100644 (file)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -255,11 +255,14 @@ M: assoc unzip
 : zip-with ( ... seq quot: ( ... key -- ... value ) -- ... alist )
     { } zip-with-as ; inline
 
-: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... assoc )
-    [ keep swap ] curry H{ } clone [
+: collect-by! ( ... assoc seq quot: ( ... obj -- ... key ) -- ... assoc )
+    [ keep swap ] curry rot [
         [ push-at ] curry compose each
     ] keep ; inline
 
+: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... assoc )
+    [ H{ } clone ] 2dip collect-by! ; inline
+
 M: sequence at*
     search-alist [ second t ] [ f ] if ;