diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 233d793483..b8aa266fb9 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -1,61 +1,27 @@ ! Copyright (C) 2005, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.order strings arrays vectors sequences -sequences.private accessors fry combinators ; +USING: accessors combinators fry kernel math math.order +sequences sequences.private ; IN: grouping ERROR: groups-error seq group-size ; - ; inline + +M: chunking nth-unsafe group@ ; inline + M: chunking set-nth group@ 0 swap copy ; + 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@ ; inline -M: slice-chunking nth-unsafe group@ ; 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 ) dup 0 <= [ groups-error ] when ; inline @@ -64,16 +30,32 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ; PRIVATE> -TUPLE: groups < chunking-seq ; -INSTANCE: groups slice-chunking -INSTANCE: groups abstract-groups +TUPLE: groups < chunking ; + +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 : ( seq n -- groups ) groups new-groups ; inline -TUPLE: clumps < chunking-seq ; -INSTANCE: clumps slice-chunking -INSTANCE: clumps abstract-clumps +TUPLE: clumps < chunking ; + +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 : ( seq n -- clumps ) clumps new-groups ; inline @@ -123,7 +105,10 @@ M: circular-slice virtual@ C: circular-slice -TUPLE: circular-clumps < chunking-seq ; +TUPLE: circular-clumps + { seq read-only } + { n read-only } ; + INSTANCE: circular-clumps sequence M: circular-clumps length