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

grouping: minor cleanup

db4
Slava Pestov 2010-03-17 19:13:25 +13:00
parent 01e5aadcd0
commit cdee2439d8
2 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
basis/grouping/authors.txt
View File

@ -1 +1,2 @@
Slava Pestov Slava Pestov
Joe Groff

20
basis/grouping/grouping.factor
View File

@ -1,8 +1,7 @@
! Copyright (C) 2005, 2010 Slava Pestov. ! 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: kernel math math.order strings arrays vectors sequences
sequences.private accessors fry combinators.short-circuit sequences.private accessors fry combinators ;
combinators ;
IN: grouping IN: grouping
<PRIVATE <PRIVATE
@ -64,8 +63,7 @@ TUPLE: chunking-seq { seq read-only } { n read-only } ;
2dup >= [ - ] [ drop ] if ; inline 2dup >= [ - ] [ drop ] if ; inline
: check-circular-clumps ( seq n -- seq n ) : check-circular-clumps ( seq n -- seq n )
2dup { [ nip 0 <= ] [ swap length > ] } 2|| 2dup 1 - swap bounds-check 2drop ; inline
[ "Invalid clump size" throw ] when ; inline
PRIVATE> PRIVATE>
@ -115,15 +113,18 @@ INSTANCE: sliced-clumps abstract-clumps
: all-eq? ( seq -- ? ) [ eq? ] monotonic? ; : all-eq? ( seq -- ? ) [ eq? ] monotonic? ;
TUPLE: circular-slice TUPLE: circular-slice { from read-only } { to read-only } { seq read-only } ;
{ from read-only }
{ to read-only }
{ seq read-only } ;
INSTANCE: circular-slice virtual-sequence INSTANCE: circular-slice virtual-sequence
M: circular-slice equal? over slice? [ sequence= ] [ 2drop f ] if ; M: circular-slice equal? over slice? [ sequence= ] [ 2drop f ] if ;
M: circular-slice hashcode* [ sequence-hashcode ] recursive-hashcode ; M: circular-slice hashcode* [ sequence-hashcode ] recursive-hashcode ;
M: circular-slice length [ to>> ] [ from>> ] bi - ; inline M: circular-slice length [ to>> ] [ from>> ] bi - ; inline
M: circular-slice virtual-exemplar seq>> ; inline M: circular-slice virtual-exemplar seq>> ; inline
M: circular-slice virtual@ M: circular-slice virtual@
[ from>> + ] [ seq>> ] bi [ length slice-mod ] keep ; inline [ from>> + ] [ seq>> ] bi [ length slice-mod ] keep ; inline
@ -155,4 +156,3 @@ M: circular-clumps nth
: circular-clump ( seq n -- array ) : circular-clump ( seq n -- array )
<circular-clumps> { } like ; inline <circular-clumps> { } like ; inline