From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 7 Aug 2022 21:15:47 +0000 (-0500)
Subject: assocs: refactor collect-by to use collect-by!
X-Git-Tag: 0.99~1170
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=521deebfd9a15a822bc2d595b5f8e1ff750817d5

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

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 4b03479044..931da8f2e0 100644
--- 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 bb9fd94c38..fdfacb8fcc 100644
--- 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 ;