steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

grouping: simplify since we always slice.

db4
John Benediktsson 2015-08-14 21:12:28 -07:00
parent 883f65d0e4
commit 04ec78831d
1 changed files with 38 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
basis/grouping/grouping.factor
View File

@ -1,61 +1,27 @@
! Copyright (C) 2005, 2010 Slava Pestov, Joe Groff. ! Copyright (C) 2005, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.order strings arrays vectors sequences USING: accessors combinators fry kernel math math.order
sequences.private accessors fry combinators ; sequences sequences.private ;
IN: grouping IN: grouping
ERROR: groups-error seq group-size ; ERROR: groups-error seq group-size ;
<PRIVATE
MIXIN: chunking <PRIVATE
INSTANCE: chunking sequence
GENERIC: group@ ( n groups -- from to seq ) GENERIC: group@ ( n groups -- from to seq )
TUPLE: chunking { seq read-only } { n read-only } ;
INSTANCE: chunking sequence
M: chunking nth group@ <slice> ; inline
M: chunking nth-unsafe group@ <slice-unsafe> ; inline
M: chunking set-nth group@ <slice> 0 swap copy ; M: chunking set-nth group@ <slice> 0 swap copy ;
M: chunking like drop { } like ; inline M: chunking like drop { } like ; inline
MIXIN: subseq-chunking
INSTANCE: subseq-chunking chunking
INSTANCE: subseq-chunking sequence
M: subseq-chunking nth group@ subseq ; inline
MIXIN: slice-chunking
INSTANCE: slice-chunking chunking
INSTANCE: slice-chunking sequence
M: slice-chunking nth group@ <slice> ; inline
M: slice-chunking nth-unsafe group@ <slice-unsafe> ; inline
MIXIN: abstract-groups
INSTANCE: abstract-groups sequence
M: abstract-groups length
[ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ; inline
M: abstract-groups set-length
[ n>> * ] [ seq>> ] bi set-length ; inline
M: abstract-groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ; inline
MIXIN: abstract-clumps
INSTANCE: abstract-clumps sequence
M: abstract-clumps length
dup seq>> length [ drop 0 ] [
swap [ 1 + ] [ n>> ] bi* [-]
] if-zero ; inline
M: abstract-clumps set-length
[ n>> + 1 - ] [ seq>> ] bi set-length ; inline
M: abstract-clumps group@
[ n>> over + ] [ seq>> ] bi ; inline
TUPLE: chunking-seq { seq read-only } { n read-only } ;
: check-groups ( seq n -- seq n ) : check-groups ( seq n -- seq n )
dup 0 <= [ groups-error ] when ; inline dup 0 <= [ groups-error ] when ; inline
@ -64,16 +30,32 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ;
PRIVATE> PRIVATE>
TUPLE: groups < chunking-seq ; TUPLE: groups < chunking ;
INSTANCE: groups slice-chunking
INSTANCE: groups abstract-groups M: groups length
[ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ; inline
M: groups set-length
[ n>> * ] [ seq>> ] bi set-length ; inline
M: groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ; inline
: <groups> ( seq n -- groups ) : <groups> ( seq n -- groups )
groups new-groups ; inline groups new-groups ; inline
TUPLE: clumps < chunking-seq ; TUPLE: clumps < chunking ;
INSTANCE: clumps slice-chunking
INSTANCE: clumps abstract-clumps M: clumps length
dup seq>> length [ drop 0 ] [
swap [ 1 + ] [ n>> ] bi* [-]
] if-zero ; inline
M: clumps set-length
[ n>> + 1 - ] [ seq>> ] bi set-length ; inline
M: clumps group@
[ n>> over + ] [ seq>> ] bi ; inline
: <clumps> ( seq n -- clumps ) : <clumps> ( seq n -- clumps )
clumps new-groups ; inline clumps new-groups ; inline
@ -123,7 +105,10 @@ M: circular-slice virtual@
C: <circular-slice> circular-slice C: <circular-slice> circular-slice
TUPLE: circular-clumps < chunking-seq ; TUPLE: circular-clumps
{ seq read-only }
{ n read-only } ;
INSTANCE: circular-clumps sequence INSTANCE: circular-clumps sequence
M: circular-clumps length M: circular-clumps length