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

grouping: tweak inheritance to make method precedence explicit

release
Slava Pestov 2010-01-30 21:12:49 +13:00
parent e45816cf9b
commit 22e3b71ae2
1 changed files with 30 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
basis/grouping/grouping.factor
View File

@ -6,35 +6,29 @@ IN: grouping
<PRIVATE <PRIVATE
TUPLE: chunking-seq { seq read-only } { n read-only } ; MIXIN: chunking
INSTANCE: chunking sequence
: check-groups ( n -- n )
dup 0 <= [ "Invalid group count" throw ] when ; inline
: new-groups ( seq n class -- groups )
[ check-groups ] dip boa ; inline
GENERIC: group@ ( n groups -- from to seq ) GENERIC: group@ ( n groups -- from to seq )
M: chunking-seq set-nth group@ <slice> 0 swap copy ; M: chunking set-nth group@ <slice> 0 swap copy ;
M: chunking like drop { } like ; inline
M: chunking-seq like drop { } like ; inline
MIXIN: subseq-chunking MIXIN: subseq-chunking
INSTANCE: subseq-chunking chunking
INSTANCE: subseq-chunking sequence INSTANCE: subseq-chunking sequence
M: subseq-chunking nth group@ subseq ; inline M: subseq-chunking nth group@ subseq ; inline
MIXIN: slice-chunking MIXIN: slice-chunking
INSTANCE: slice-chunking chunking
INSTANCE: slice-chunking sequence INSTANCE: slice-chunking sequence
M: slice-chunking nth group@ <slice> ; inline M: slice-chunking nth group@ <slice> ; inline
M: slice-chunking nth-unsafe group@ slice boa ; inline M: slice-chunking nth-unsafe group@ slice boa ; inline
TUPLE: abstract-groups < chunking-seq ; MIXIN: abstract-groups
INSTANCE: abstract-groups sequence
M: abstract-groups length M: abstract-groups length
[ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ; inline [ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ; inline
@ -45,7 +39,8 @@ M: abstract-groups set-length
M: abstract-groups group@ M: abstract-groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ; inline [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ; inline
TUPLE: abstract-clumps < chunking-seq ; MIXIN: abstract-clumps
INSTANCE: abstract-clumps sequence
M: abstract-clumps length M: abstract-clumps length
[ seq>> length 1 + ] [ n>> ] bi [-] ; inline [ seq>> length 1 + ] [ n>> ] bi [-] ; inline
@ -56,36 +51,44 @@ M: abstract-clumps set-length
M: abstract-clumps group@ M: abstract-clumps group@
[ n>> over + ] [ seq>> ] bi ; inline [ n>> over + ] [ seq>> ] bi ; inline
TUPLE: chunking-seq { seq read-only } { n read-only } ;
: check-groups ( n -- n )
dup 0 <= [ "Invalid group count" throw ] when ; inline
: new-groups ( seq n class -- groups )
[ check-groups ] dip boa ; inline
PRIVATE> PRIVATE>
TUPLE: groups < abstract-groups ; TUPLE: groups < chunking-seq ;
INSTANCE: groups subseq-chunking
INSTANCE: groups abstract-groups
: <groups> ( seq n -- groups ) : <groups> ( seq n -- groups )
groups new-groups ; inline groups new-groups ; inline
INSTANCE: groups subseq-chunking TUPLE: sliced-groups < chunking-seq ;
INSTANCE: sliced-groups slice-chunking
TUPLE: sliced-groups < abstract-groups ; INSTANCE: sliced-groups abstract-groups
: <sliced-groups> ( seq n -- groups ) : <sliced-groups> ( seq n -- groups )
sliced-groups new-groups ; inline sliced-groups new-groups ; inline
INSTANCE: sliced-groups slice-chunking TUPLE: clumps < chunking-seq ;
INSTANCE: clumps subseq-chunking
TUPLE: clumps < abstract-clumps ; INSTANCE: clumps abstract-clumps
: <clumps> ( seq n -- clumps ) : <clumps> ( seq n -- clumps )
clumps new-groups ; inline clumps new-groups ; inline
INSTANCE: clumps subseq-chunking TUPLE: sliced-clumps < chunking-seq ;
INSTANCE: sliced-clumps slice-chunking
TUPLE: sliced-clumps < abstract-clumps ; INSTANCE: sliced-clumps abstract-clumps
: <sliced-clumps> ( seq n -- clumps ) : <sliced-clumps> ( seq n -- clumps )
sliced-clumps new-groups ; inline sliced-clumps new-groups ; inline
INSTANCE: sliced-clumps slice-chunking
: group ( seq n -- array ) <groups> { } like ; : group ( seq n -- array ) <groups> { } like ;
: clump ( seq n -- array ) <clumps> { } like ; : clump ( seq n -- array ) <clumps> { } like ;