Paste: collect-by

commit fa6b0cb5fe3ae4a39095143d82f0755498492114
Author: Jon Harper <jon.harper87@gmail.com>
Date:   Thu Feb 18 20:09:19 2016 +0100

    poc move collect-by to core

diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor
index fc25c01..da543be 100644
--- a/basis/math/statistics/statistics.factor
+++ b/basis/math/statistics/statistics.factor
@@ -208,31 +208,6 @@ PRIVATE>
 : trimean ( seq -- x )
     quartile first3 [ 2 * ] dip + + 4 / ;
 
-<PRIVATE
-
-: (sequence>assoc) ( seq map-quot insert-quot assoc -- assoc )
-    [ swap curry compose each ] keep ; inline
-
-: (sequence-index>assoc) ( seq map-quot insert-quot assoc -- assoc )
-    [ swap curry compose each-index ] keep ; inline
-
-PRIVATE>
-
-: sequence>assoc! ( assoc seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) -- assoc )
-    4 nrot (sequence>assoc) ; inline
-
-: sequence>assoc ( seq map-quot insert-quot exemplar -- assoc )
-    clone (sequence>assoc) ; inline
-
-: sequence-index>assoc ( seq map-quot insert-quot exemplar -- assoc )
-    clone (sequence-index>assoc) ; inline
-
-: sequence-index>hashtable ( seq map-quot insert-quot -- hashtable )
-    H{ } sequence-index>assoc ; inline
-
-: sequence>hashtable ( seq map-quot insert-quot -- hashtable )
-    H{ } sequence>assoc ; inline
-
 : histogram! ( hashtable seq -- hashtable )
     [ ] [ inc-at ] sequence>assoc! ;
 
@@ -248,12 +223,6 @@ PRIVATE>
 : normalized-histogram ( seq -- alist )
     [ histogram ] [ length ] bi '[ _ / ] assoc-map ;
 
-: collect-index-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
-    [ dip swap ] curry [ push-at ] sequence-index>hashtable ; inline
-
-: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
-    [ keep swap ] curry [ push-at ] sequence>hashtable ; inline
-
 : equal-probabilities ( n -- array )
     dup recip <array> ; inline
 
diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor
index d8e6921..a0ea727 100644
--- a/basis/tools/memory/memory.factor
+++ b/basis/tools/memory/memory.factor
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs binary-search classes
 classes.struct combinators combinators.smart continuations fry
 generalizations generic grouping io io.styles kernel make math
-math.order math.parser math.statistics memory layouts namespaces
+math.order math.parser assocs math.statistics memory layouts namespaces
 parser prettyprint sequences sequences.generalizations sorting
 splitting strings system vm words hints hashtables ;
 IN: tools.memory
diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 9e82bc8..c1677f9 100644
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -204,6 +204,40 @@ M: assoc values [ nip ] { } assoc>map ;
 : map>alist ( ... seq quot: ( ... elt -- ... key value ) -- ... alist )
     { } map>assoc ; inline
 
+: push-at ( value key assoc -- )
+    [ ?push ] change-at ;
+
+<PRIVATE
+
+: (sequence>assoc) ( seq map-quot insert-quot assoc -- assoc )
+    [ swap curry compose each ] keep ; inline
+
+: (sequence-index>assoc) ( seq map-quot insert-quot assoc -- assoc )
+    [ swap curry compose each-index ] keep ; inline
+
+PRIVATE>
+
+: sequence>assoc! ( assoc seq map-quot: ( x -- ..y ) insert-quot: ( ..y assoc -- ) -- assoc )
+    [ [ [ ] dip swap ] dip swap ] dip swap (sequence>assoc) ; inline
+
+: sequence>assoc ( seq map-quot insert-quot exemplar -- assoc )
+    clone (sequence>assoc) ; inline
+
+: sequence-index>assoc ( seq map-quot insert-quot exemplar -- assoc )
+    clone (sequence-index>assoc) ; inline
+
+: sequence-index>hashtable ( seq map-quot insert-quot -- hashtable )
+    H{ } sequence-index>assoc ; inline
+
+: sequence>hashtable ( seq map-quot insert-quot -- hashtable )
+    H{ } sequence>assoc ; inline
+
+: collect-index-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
+    [ dip swap ] curry [ push-at ] sequence-index>hashtable ; inline
+
+: collect-by ( ... seq quot: ( ... obj -- ... key ) -- ... hashtable )
+    [ keep swap ] curry [ push-at ] sequence>hashtable ; inline
+
 : extract-keys ( seq assoc -- subassoc )
     [ [ dupd at ] curry ] keep map>assoc ;
 
@@ -213,9 +247,6 @@ M: assoc value-at* swap [ = nip ] curry assoc-find nip ;
 
 : value? ( value assoc -- ? ) value-at* nip ;
 
-: push-at ( value key assoc -- )
-    [ ?push ] change-at ;
-
 : zip-as ( keys values exemplar -- assoc )
     dup sequence? [
         [ 2array ] swap 2map-as