Tweak grouping code for better method inlining

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -5,7 +5,7 @@ strings sbufs sequences.private slots.private combinators
 definitions system layouts vectors math.partial-dispatch
 math.order math.functions accessors hashtables classes assocs
 io.encodings.utf8 io.encodings.ascii io.encodings fry slots
-sorting.private combinators.short-circuit
+sorting.private combinators.short-circuit grouping prettyprint
 compiler.tree
 compiler.tree.combinators
 compiler.tree.cleanup
@@ -505,3 +505,8 @@ cell-bits 32 = [
     [ { null } declare [ 1 ] [ 2 ] if ]
     build-tree normalize propagate cleanup check-nodes
 ] unit-test
+
+[ t ] [
+    [ { array } declare 2 <groups> [ . . ] assoc-each ]
+    \ nth-unsafe inlined?
+] unit-test

core/grouping/grouping.factor

@@ -1,10 +1,12 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.order strings arrays vectors sequences
-accessors ;
+sequences.private accessors ;
 IN: grouping
 
-TUPLE: abstract-groups { seq read-only } { n read-only } ;
+<PRIVATE
+
+TUPLE: chunking-seq { seq read-only } { n read-only } ;
 
 : check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
 
@@ -13,55 +15,73 @@ TUPLE: abstract-groups { seq read-only } { n read-only } ;
 
 GENERIC: group@ ( n groups -- from to seq )
 
-M: abstract-groups nth group@ subseq ;
+M: chunking-seq set-nth group@ <slice> 0 swap copy ;
 
-M: abstract-groups set-nth group@ <slice> 0 swap copy ;
+M: chunking-seq like drop { } like ;
 
-M: abstract-groups like drop { } like ;
+INSTANCE: chunking-seq sequence
 
-INSTANCE: abstract-groups sequence
+MIXIN: subseq-chunking
+
+M: subseq-chunking nth group@ subseq ;
+
+MIXIN: slice-chunking
+
+M: slice-chunking nth group@ <slice> ;
+
+M: slice-chunking nth-unsafe group@ slice boa ;
+
+TUPLE: abstract-groups < chunking-seq ;
+
+M: abstract-groups length
+    [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
+
+M: abstract-groups set-length
+    [ n>> * ] [ seq>> ] bi set-length ;
+
+M: abstract-groups group@
+    [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
+
+TUPLE: abstract-clumps < chunking-seq ;
+
+M: abstract-clumps length
+    [ seq>> length ] [ n>> ] bi - 1+ ;
+
+M: abstract-clumps set-length
+    [ n>> + 1- ] [ seq>> ] bi set-length ;
+
+M: abstract-clumps group@
+    [ n>> over + ] [ seq>> ] bi ;
+
+PRIVATE>
 
 TUPLE: groups < abstract-groups ;
 
 : <groups> ( seq n -- groups )
     groups new-groups ; inline
 
-M: groups length
-    [ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
+INSTANCE: groups subseq-chunking
 
-M: groups set-length
-    [ n>> * ] [ seq>> ] bi set-length ;
-
-M: groups group@
-    [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
-
-TUPLE: sliced-groups < groups ;
+TUPLE: sliced-groups < abstract-groups ;
 
 : <sliced-groups> ( seq n -- groups )
     sliced-groups new-groups ; inline
 
-M: sliced-groups nth group@ <slice> ;
+INSTANCE: sliced-groups slice-chunking
 
-TUPLE: clumps < abstract-groups ;
+TUPLE: clumps < abstract-clumps ;
 
 : <clumps> ( seq n -- clumps )
     clumps new-groups ; inline
 
-M: clumps length
-    [ seq>> length ] [ n>> ] bi - 1+ ;
+INSTANCE: clumps subseq-chunking
 
-M: clumps set-length
-    [ n>> + 1- ] [ seq>> ] bi set-length ;
-
-M: clumps group@
-    [ n>> over + ] [ seq>> ] bi ;
-
-TUPLE: sliced-clumps < clumps ;
+TUPLE: sliced-clumps < abstract-clumps ;
 
 : <sliced-clumps> ( seq n -- clumps )
     sliced-clumps new-groups ; inline
 
-M: sliced-clumps nth group@ <slice> ;
+INSTANCE: sliced-clumps slice-chunking
 
 : group ( seq n -- array ) <groups> { } like ;