assoc-find is no longer generic

db4
Slava Pestov 2008-06-09 05:22:21 -05:00
parent 05fb5fcb17
commit 29fa4a8a54
48 changed files with 256 additions and 299 deletions

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays alien alien.c-types alien.structs alien.arrays
alien.strings kernel math namespaces parser sequences words
quotations math.parser splitting effects prettyprint
quotations math.parser splitting grouping effects prettyprint
prettyprint.sections prettyprint.backend assocs combinators ;
IN: alien.syntax

View File

@ -39,9 +39,7 @@ ARTICLE: "assocs-protocol" "Associative mapping protocol"
"All associative mappings must implement methods on the following generic words:"
{ $subsection at* }
{ $subsection assoc-size }
"At least one of the following two generic words must have a method; the " { $link assoc } " mixin has default definitions which are mutually recursive:"
{ $subsection >alist }
{ $subsection assoc-find }
"Mutable assocs should implement the following additional words:"
{ $subsection set-at }
{ $subsection delete-at }
@ -94,6 +92,7 @@ $nl
$nl
"The standard functional programming idioms:"
{ $subsection assoc-each }
{ $subsection assoc-find }
{ $subsection assoc-map }
{ $subsection assoc-push-if }
{ $subsection assoc-filter }
@ -139,8 +138,7 @@ HELP: new-assoc
HELP: assoc-find
{ $values { "assoc" assoc } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "key" "the successful key, or f" } { "value" "the successful value, or f" } { "?" "a boolean" } }
{ $contract "Applies a predicate quotation to each entry in the assoc. Returns the key and value that the quotation succeeds on, or " { $link f } " for both if the quotation fails. It also returns a boolean describing whether there was anything found; this can be used to distinguish between a key and a value equal to " { $link f } ", or nothing being found." }
{ $notes "The " { $link assoc } " mixin has a default implementation for this generic word which first converts the assoc to an association list, then iterates over that with the " { $link find } " combinator for sequences." } ;
{ $description "Applies a predicate quotation to each entry in the assoc. Returns the key and value that the quotation succeeds on, or " { $link f } " for both if the quotation fails. It also returns a boolean describing whether there was anything found; this can be used to distinguish between a key and a value equal to " { $link f } ", or nothing being found." } ;
HELP: clear-assoc
{ $values { "assoc" assoc } }

View File

@ -20,11 +20,9 @@ GENERIC: assoc-clone-like ( assoc exemplar -- newassoc )
GENERIC: >alist ( assoc -- newassoc )
GENERIC# assoc-find 1 ( assoc quot -- key value ? ) inline
M: assoc assoc-find
>r >alist [ first2 ] r> compose find swap
[ first2 t ] [ drop f f f ] if ;
: assoc-find ( assoc quot -- key value ? )
>r >alist r> [ first2 ] prepose find swap
[ first2 t ] [ drop f f f ] if ; inline
: key? ( key assoc -- ? ) at* nip ; inline
@ -153,7 +151,7 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
: extract-keys ( seq assoc -- subassoc )
[ [ dupd at ] curry ] keep map>assoc ;
M: assoc >alist [ 2array ] { } assoc>map ;
! M: assoc >alist [ 2array ] { } assoc>map ;
: value-at ( value assoc -- key/f )
swap [ = nip ] curry assoc-find 2drop ;

View File

@ -4,7 +4,7 @@ USING: alien arrays bit-arrays byte-arrays generic assocs
hashtables assocs hashtables.private io kernel kernel.private
math namespaces parser prettyprint sequences sequences.private
strings sbufs vectors words quotations assocs system layouts
splitting growable classes classes.builtin classes.tuple
splitting grouping growable classes classes.builtin classes.tuple
classes.tuple.private words.private io.binary io.files vocabs
vocabs.loader source-files definitions debugger float-arrays
quotations.private sequences.private combinators

View File

@ -51,9 +51,8 @@ TUPLE: check-mixin-class mixin ;
#! updated by transitivity; the mixins usages appear in
#! class-usages of the member, now that it's been added.
[ 2drop ] [
[ [ suffix ] change-mixin-class ] 2keep
nip update-classes
! over new-class? [ nip update-classes/new ] [ drop update-classes ] if
[ [ suffix ] change-mixin-class ] 2keep drop
dup new-class? [ update-classes/new ] [ update-classes ] if
] if-mixin-member? ;
: remove-mixin-instance ( class mixin -- )

View File

@ -1,7 +1,7 @@
IN: compiler.tests
USING: compiler tools.test namespaces sequences
kernel.private kernel math continuations continuations.private
words splitting sorting ;
words splitting grouping sorting ;
: symbolic-stack-trace ( -- newseq )
error-continuation get continuation-call callstack>array

View File

@ -81,14 +81,8 @@ ERROR: no-method object generic ;
"methods" word-prop
[ generic get mangle-method ] assoc-map
[ find-default default set ]
[
generic get "inline" word-prop [
<predicate-dispatch-engine>
] [
<big-dispatch-engine>
] if
] bi
engine>quot
[ <big-dispatch-engine> ]
bi engine>quot
]
} cleave
] with-scope ;

View File

@ -0,0 +1,97 @@
USING: help.markup help.syntax sequences strings ;
IN: grouping
ARTICLE: "groups-clumps" "Groups and clumps"
"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
{ $subsection groups }
{ $subsection <groups> }
{ $subsection <sliced-groups> }
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
{ $subsection clumps }
{ $subsection <clumps> }
{ $subsection <sliced-clumps> }
"The difference can be summarized as the following:"
{ $list
{ "With groups, the subsequences form the original sequence when concatenated:"
{ $unchecked-example "dup n groups concat sequence= ." "t" }
}
{ "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
{ $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
}
} ;
HELP: groups
{ $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
$nl
"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
{ $see-also group } ;
HELP: group
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into disjoint groups of " { $snippet "n" } " elements and collects the groups into a new array." }
{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." }
{ $examples
{ $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 group ." "{ { 3 1 } { 3 3 } { 7 } }" }
} ;
HELP: <groups>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
{ $description "Outputs a virtual sequence whose elements are disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
{ $example
"USING: arrays kernel prettyprint sequences splitting ;"
"9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
}
} ;
HELP: <sliced-groups>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
{ $example
"USING: arrays kernel prettyprint sequences splitting ;"
"9 >array 3 <sliced-groups>"
"dup [ reverse-here ] each concat >array ."
"{ 2 1 0 5 4 3 8 7 6 }"
}
} ;
HELP: clumps
{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
$nl
"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
HELP: clump
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
{ $examples
{ $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
} ;
HELP: <clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
"Running averages:"
{ $example
"USING: splitting sequences math prettyprint kernel ;"
"IN: scratchpad"
": share-price"
" { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
""
"share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
"{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
}
} ;
HELP: <sliced-clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
{ clumps groups } related-words
{ clump group } related-words
{ <clumps> <groups> } related-words
{ <sliced-clumps> <sliced-groups> } related-words

View File

@ -0,0 +1,12 @@
USING: grouping tools.test kernel sequences arrays ;
IN: grouping.tests
[ { 1 2 3 } 0 group ] must-fail
[ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test
[ { V{ "a" "b" } V{ f f } } ] [
V{ "a" "b" } clone 2 <groups>
2 over set-length
>array
] unit-test

View File

@ -0,0 +1,68 @@
! 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 ;
IN: grouping
TUPLE: abstract-groups seq n ;
: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
: new-groups ( seq n class -- groups )
>r check-groups r> boa ; inline
GENERIC: group@ ( n groups -- from to seq )
M: abstract-groups nth group@ subseq ;
M: abstract-groups set-nth group@ <slice> 0 swap copy ;
M: abstract-groups like drop { } like ;
INSTANCE: abstract-groups sequence
TUPLE: groups < abstract-groups ;
: <groups> ( seq n -- groups )
groups new-groups ; inline
M: groups length
[ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
M: groups set-length
[ n>> * ] [ seq>> ] bi set-length ;
M: groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
TUPLE: sliced-groups < groups ;
: <sliced-groups> ( seq n -- groups )
sliced-groups new-groups ; inline
M: sliced-groups nth group@ <slice> ;
TUPLE: clumps < abstract-groups ;
: <clumps> ( seq n -- clumps )
clumps new-groups ; inline
M: clumps length
[ seq>> length ] [ n>> ] bi - 1+ ;
M: clumps set-length
[ n>> + 1- ] [ seq>> ] bi set-length ;
M: clumps group@
[ n>> over + ] [ seq>> ] bi ;
TUPLE: sliced-clumps < groups ;
: <sliced-clumps> ( seq n -- clumps )
sliced-clumps new-groups ; inline
M: sliced-clumps nth group@ <slice> ;
: group ( seq n -- array ) <groups> { } like ;
: clump ( seq n -- array ) <clumps> { } like ;

View File

@ -10,9 +10,7 @@ $nl
$nl
"The " { $link hash-count } " slot is the number of entries including deleted entries, and " { $link hash-deleted } " is the number of deleted entries."
{ $subsection <hash-array> }
{ $subsection nth-pair }
{ $subsection set-nth-pair }
{ $subsection find-pair }
"If a hashtable's keys are mutated, or if hashing algorithms change, hashtables can be rehashed:"
{ $subsection rehash } ;
@ -74,24 +72,12 @@ HELP: new-key@
{ $values { "key" "a key" } { "hash" hashtable } { "array" "the underlying array of the hashtable" } { "n" "the index where the key would be stored" } { "empty?" "a boolean indicating whether the location is currently empty" } }
{ $description "Searches the hashtable for the key using a linear probing strategy. If the key is not present in the hashtable, outputs the index where it should be stored." } ;
HELP: nth-pair
{ $values { "n" "an index in the sequence" } { "seq" "a sequence" } { "key" "the first element of the pair" } { "value" "the second element of the pair" } }
{ $description "Fetches the elements with index " { $snippet "n" } " and " { $snippet "n+1" } ", respectively." }
{ $warning "This word is in the " { $vocab-link "hashtables.private" } " vocabulary because it does not perform bounds checks." } ;
{ nth-pair set-nth-pair } related-words
HELP: set-nth-pair
{ $values { "value" "the second element of the pair" } { "key" "the first element of the pair" } { "seq" "a sequence" } { "n" "an index in the sequence" } }
{ $description "Stores a pair of values into the elements with index " { $snippet "n" } " and " { $snippet "n+1" } ", respectively." }
{ $warning "This word is in the " { $vocab-link "hashtables.private" } " vocabulary because it does not perform bounds checks." }
{ $side-effects "seq" } ;
HELP: find-pair
{ $values { "array" "an array of pairs" } { "quot" "a quotation with stack effect " { $snippet "( key value -- ? )" } } { "key" "the successful key" } { "value" "the successful value" } { "?" "a boolean of whether there was success" } }
{ $description "Applies a quotation to successive pairs in the array, yielding the first successful pair." }
{ $warning "This word is in the " { $vocab-link "hashtables.private" } " vocabulary because passing an array of odd length can lead to memory corruption." } ;
HELP: reset-hash
{ $values { "n" "a positive integer specifying hashtable capacity" } { "hash" hashtable } }
{ $description "Resets the underlying array of the hashtable to a new array with the given capacity. Removes all entries from the hashtable." }

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel kernel.private slots.private math assocs
math.private sequences sequences.private vectors ;
math.private sequences sequences.private vectors grouping ;
IN: hashtables
<PRIVATE
@ -48,10 +48,6 @@ IN: hashtables
: new-key@ ( key hash -- array n empty? )
hash-array 2dup hash@ (new-key@) ; inline
: nth-pair ( n seq -- key value )
swap 2 fixnum+fast 2dup slot -rot 1 fixnum+fast slot ;
inline
: set-nth-pair ( value key seq n -- )
2 fixnum+fast [ set-slot ] 2keep
1 fixnum+fast set-slot ; inline
@ -67,28 +63,8 @@ IN: hashtables
[ rot hash-count+ set-nth-pair t ]
[ rot drop set-nth-pair f ] if ; inline
: find-pair-next >r 2 fixnum+fast r> ; inline
: (find-pair) ( quot i array -- key value ? )
2dup array-capacity eq? [
3drop f f f
] [
2dup array-nth tombstone? [
find-pair-next (find-pair)
] [
[ nth-pair rot call ] 3keep roll [
nth-pair >r nip r> t
] [
find-pair-next (find-pair)
] if
] if
] if ; inline
: find-pair ( array quot -- key value ? )
0 rot (find-pair) ; inline
: (rehash) ( hash array -- )
[ swap pick (set-hash) drop f ] find-pair 2drop 2drop ;
: (rehash) ( hash alist -- )
swap [ swapd (set-hash) drop ] curry assoc-each ;
: hash-large? ( hash -- ? )
[ hash-count 3 fixnum*fast ]
@ -98,7 +74,7 @@ IN: hashtables
[ hash-deleted 10 fixnum*fast ] [ hash-count ] bi fixnum> ;
: grow-hash ( hash -- )
[ dup hash-array swap assoc-size 1+ ] keep
[ dup >alist swap assoc-size 1+ ] keep
[ reset-hash ] keep
swap (rehash) ;
@ -136,8 +112,8 @@ M: hashtable assoc-size ( hash -- n )
dup hash-count swap hash-deleted - ;
: rehash ( hash -- )
dup hash-array
dup length ((empty)) <array> pick set-hash-array
dup >alist
over hash-array length ((empty)) <array> pick set-hash-array
0 pick set-hash-count
0 pick set-hash-deleted
(rehash) ;
@ -148,8 +124,8 @@ M: hashtable set-at ( value key hash -- )
: associate ( value key -- hash )
2 <hashtable> [ set-at ] keep ;
M: hashtable assoc-find ( hash quot -- key value ? )
>r hash-array r> find-pair ;
M: hashtable >alist
hash-array 2 <groups> [ first tombstone? not ] filter ;
M: hashtable clone
(clone) dup hash-array clone over set-hash-array ;

View File

@ -3,7 +3,7 @@
USING: arrays kernel math sequences words ;
IN: math.bitfields
GENERIC: (bitfield) inline
GENERIC: (bitfield) ( value accum shift -- newaccum )
M: integer (bitfield) ( value accum shift -- newaccum )
swapd shift bitor ;

View File

@ -4,7 +4,7 @@ IN: prettyprint
USING: arrays generic generic.standard assocs io kernel
math namespaces sequences strings io.styles io.streams.string
vectors words prettyprint.backend prettyprint.sections
prettyprint.config sorting splitting math.parser vocabs
prettyprint.config sorting splitting grouping math.parser vocabs
definitions effects classes.builtin classes.tuple io.files
classes continuations hashtables classes.mixin classes.union
classes.intersection classes.predicate classes.singleton

View File

@ -1,25 +1,6 @@
USING: help.markup help.syntax sequences strings ;
IN: splitting
ARTICLE: "groups-clumps" "Groups and clumps"
"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
{ $subsection groups }
{ $subsection <groups> }
{ $subsection <sliced-groups> }
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
{ $subsection clumps }
{ $subsection <clumps> }
{ $subsection <sliced-clumps> }
"The difference can be summarized as the following:"
{ $list
{ "With groups, the subsequences form the original sequence when concatenated:"
{ $unchecked-example "dup n groups concat sequence= ." "t" }
}
{ "With clumps, collecting the first element of each subsequence but the last one, together with the last subseqence, yields the original sequence:"
{ $unchecked-example "dup n clumps unclip-last >r [ first ] map r> append sequence= ." "t" }
}
} ;
ARTICLE: "sequences-split" "Splitting sequences"
"Splitting sequences at occurrences of subsequences:"
{ $subsection ?head }
@ -49,83 +30,6 @@ HELP: split
{ $description "Splits " { $snippet "seq" } " at each occurrence of an element of " { $snippet "separators" } ", and outputs an array of pieces. The pieces do not include the elements along which the sequence was split." }
{ $examples { $example "USING: prettyprint splitting ;" "\"hello world-how are you?\" \" -\" split ." "{ \"hello\" \"world\" \"how\" \"are\" \"you?\" }" } } ;
HELP: groups
{ $class-description "Instances are virtual sequences whose elements are disjoint fixed-length subsequences of an underlying sequence. Groups are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
$nl
"New groups are created by calling " { $link <groups> } " and " { $link <sliced-groups> } "." }
{ $see-also group } ;
HELP: group
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into disjoint groups of " { $snippet "n" } " elements and collects the groups into a new array." }
{ $notes "If the sequence length is not a multiple of " { $snippet "n" } ", the final subsequence in the list will be shorter than " { $snippet "n" } " elements." }
{ $examples
{ $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 group ." "{ { 3 1 } { 3 3 } { 7 } }" }
} ;
HELP: <groups>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
{ $description "Outputs a virtual sequence whose elements are disjoint subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
{ $example
"USING: arrays kernel prettyprint sequences splitting ;"
"9 >array 3 <groups> dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }"
}
} ;
HELP: <sliced-groups>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "groups" groups } }
{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
{ $example
"USING: arrays kernel prettyprint sequences splitting ;"
"9 >array 3 <sliced-groups>"
"dup [ reverse-here ] each concat >array ."
"{ 2 1 0 5 4 3 8 7 6 }"
}
} ;
HELP: clumps
{ $class-description "Instances are virtual sequences whose elements are overlapping fixed-length subsequences o an underlying sequence. Clumps are mutable and resizable if the underlying sequence is mutable and resizable, respectively."
$nl
"New clumps are created by calling " { $link <clumps> } " and " { $link <sliced-clumps> } "." } ;
HELP: clump
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "array" "a sequence of sequences" } }
{ $description "Splits the sequence into overlapping clumps of " { $snippet "n" } " elements and collects the clumps into a new array." }
{ $errors "Throws an error if " { $snippet "n" } " is smaller than the length of the sequence." }
{ $examples
{ $example "USING: splitting prettyprint ;" "{ 3 1 3 3 7 } 2 clump ." "{ { 3 1 } { 1 3 } { 3 3 } { 3 7 } }" }
} ;
HELP: <clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
{ $description "Outputs a virtual sequence whose elements are overlapping subsequences of " { $snippet "n" } " elements from the underlying sequence." }
{ $examples
"Running averages:"
{ $example
"USING: splitting sequences math prettyprint kernel ;"
"IN: scratchpad"
": share-price"
" { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
""
"share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
"{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
}
} ;
HELP: <sliced-clumps>
{ $values { "seq" "a sequence" } { "n" "a non-negative integer" } { "clumps" clumps } }
{ $description "Outputs a virtual sequence whose elements are overlapping slices of " { $snippet "n" } " elements from the underlying sequence." } ;
{ clumps groups } related-words
{ clump group } related-words
{ <clumps> <groups> } related-words
{ <sliced-clumps> <sliced-groups> } related-words
HELP: ?head
{ $values { "seq" "a sequence" } { "begin" "a sequence" } { "newseq" "a new sequence" } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "seq" } " starts with " { $snippet "begin" } ". If there is a match, outputs the subrange of " { $snippet "seq" } " excluding " { $snippet "begin" } ", and " { $link t } ". If there is no match, outputs " { $snippet "seq" } " and " { $link f } "." } ;

View File

@ -1,10 +1,6 @@
USING: splitting tools.test kernel sequences arrays ;
IN: splitting.tests
[ { 1 2 3 } 0 group ] must-fail
[ { "hell" "o wo" "rld" } ] [ "hello world" 4 group ] unit-test
[ "hello" "world ." ] [ "hello world ." " " split1 ] unit-test
[ "hello" "world-+." ] [ "hello-+world-+." "-+" split1 ] unit-test
[ "goodbye" f ] [ "goodbye" " " split1 ] unit-test
@ -56,9 +52,3 @@ unit-test
[ { "hello" "hi" } ] [ "hello\nhi" string-lines ] unit-test
[ { "hello" "hi" } ] [ "hello\rhi" string-lines ] unit-test
[ { "hello" "hi" } ] [ "hello\r\nhi" string-lines ] unit-test
[ { V{ "a" "b" } V{ f f } } ] [
V{ "a" "b" } clone 2 <groups>
2 over set-length
>array
] unit-test

View File

@ -4,69 +4,6 @@ USING: kernel math namespaces strings arrays vectors sequences
sets math.order accessors ;
IN: splitting
TUPLE: abstract-groups seq n ;
: check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
: construct-groups ( seq n class -- groups )
>r check-groups r> boa ; inline
GENERIC: group@ ( n groups -- from to seq )
M: abstract-groups nth group@ subseq ;
M: abstract-groups set-nth group@ <slice> 0 swap copy ;
M: abstract-groups like drop { } like ;
INSTANCE: abstract-groups sequence
TUPLE: groups < abstract-groups ;
: <groups> ( seq n -- groups )
groups construct-groups ; inline
M: groups length
[ seq>> length ] [ n>> ] bi [ + 1- ] keep /i ;
M: groups set-length
[ n>> * ] [ seq>> ] bi set-length ;
M: groups group@
[ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ;
TUPLE: sliced-groups < groups ;
: <sliced-groups> ( seq n -- groups )
sliced-groups construct-groups ; inline
M: sliced-groups nth group@ <slice> ;
TUPLE: clumps < abstract-groups ;
: <clumps> ( seq n -- clumps )
clumps construct-groups ; inline
M: clumps length
[ seq>> length ] [ n>> ] bi - 1+ ;
M: clumps set-length
[ n>> + 1- ] [ seq>> ] bi set-length ;
M: clumps group@
[ n>> over + ] [ seq>> ] bi ;
TUPLE: sliced-clumps < groups ;
: <sliced-clumps> ( seq n -- clumps )
sliced-clumps construct-groups ; inline
M: sliced-clumps nth group@ <slice> ;
: group ( seq n -- array ) <groups> { } like ;
: clump ( seq n -- array ) <clumps> { } like ;
: ?head ( seq begin -- newseq ? )
2dup head? [ length tail t ] [ drop f ] if ;

View File

@ -1,5 +1,5 @@
USING: kernel math sequences namespaces io.binary splitting
strings hashtables ;
grouping strings hashtables ;
IN: base64
<PRIVATE

View File

@ -1,4 +1,5 @@
USING: namespaces math sequences splitting kernel columns ;
USING: namespaces math sequences splitting grouping
kernel columns ;
IN: benchmark.dispatch2
: sequences ( -- seq )

View File

@ -1,5 +1,5 @@
USING: sequences math mirrors splitting kernel namespaces
assocs alien.syntax columns ;
USING: sequences math mirrors splitting grouping
kernel namespaces assocs alien.syntax columns ;
IN: benchmark.dispatch3
GENERIC: g ( obj -- str )

View File

@ -1,6 +1,6 @@
USING: io io.files io.streams.duplex kernel sequences
sequences.private strings vectors words memoize splitting
hints unicode.case continuations io.encodings.ascii ;
grouping hints unicode.case continuations io.encodings.ascii ;
IN: benchmark.reverse-complement
MEMO: trans-map ( -- str )

View File

@ -1,7 +1,7 @@
! See http://www.faqs.org/rfcs/rfc1321.html
USING: kernel io io.binary io.files io.streams.byte-array math
math.functions math.parser namespaces splitting strings
math.functions math.parser namespaces splitting grouping strings
sequences crypto.common byte-arrays locals sequences.private
io.encodings.binary symbols math.bitfields.lib checksums ;
IN: checksums.md5

View File

@ -1,5 +1,6 @@
USING: crypto.common kernel splitting math sequences namespaces
io.binary symbols math.bitfields.lib checksums ;
USING: crypto.common kernel splitting grouping
math sequences namespaces io.binary symbols
math.bitfields.lib checksums ;
IN: checksums.sha2
<PRIVATE

View File

@ -1,6 +1,6 @@
USING: arrays kernel io io.binary sbufs splitting strings sequences
namespaces math math.parser parser hints math.bitfields.lib
assocs ;
USING: arrays kernel io io.binary sbufs splitting grouping
strings sequences namespaces math math.parser parser
hints math.bitfields.lib assocs ;
IN: crypto.common
: w+ ( int int -- int ) + 32 bits ; inline

View File

@ -12,8 +12,7 @@ PROTOCOL: sequence-protocol
PROTOCOL: assoc-protocol
at* assoc-size >alist set-at assoc-clone-like
{ assoc-find 1 } delete-at clear-assoc new-assoc
assoc-like ;
delete-at clear-assoc new-assoc assoc-like ;
PROTOCOL: input-stream-protocol
stream-read1 stream-read stream-read-partial stream-readln

View File

@ -1,5 +1,5 @@
USING: arrays io io.streams.string kernel math math.parser namespaces
prettyprint sequences sequences.lib splitting strings ascii ;
prettyprint sequences sequences.lib splitting grouping strings ascii ;
IN: hexdump
<PRIVATE

View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Gavin Harrison
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math sequences kernel.private namespaces arrays io
io.files splitting io.binary math.functions vectors quotations
combinators io.encodings.binary ;
io.files splitting grouping io.binary math.functions vectors
quotations combinators io.encodings.binary ;
IN: icfp.2006
SYMBOL: regs

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.encodings io.backend io.ports io.streams.duplex
io splitting sequences sequences.lib namespaces kernel
io splitting grouping sequences sequences.lib namespaces kernel
destructors math concurrency.combinators accessors
arrays continuations quotations ;
IN: io.pipes

View File

@ -3,7 +3,7 @@
USING: math kernel io sequences io.buffers io.timeouts generic
byte-vectors system io.encodings math.order io.backend
continuations debugger classes byte-arrays namespaces splitting
dlists assocs io.encodings.binary inspector accessors
grouping dlists assocs io.encodings.binary inspector accessors
destructors ;
IN: io.ports

View File

@ -5,7 +5,8 @@ USING: generic kernel io.backend namespaces continuations
sequences arrays io.encodings io.ports io.streams.duplex
io.encodings.ascii alien.strings io.binary accessors destructors
classes debugger byte-arrays system combinators parser
alien.c-types math.parser splitting math assocs inspector ;
alien.c-types math.parser splitting grouping
math assocs inspector ;
IN: io.sockets
<< {

View File

@ -1,7 +1,7 @@
! Fast Fourier Transform, copyright (C) 2007 Hans Schmid
! http://dressguardmeister.blogspot.com/2007/01/fft.html
USING: arrays sequences math math.vectors math.constants
math.functions kernel splitting columns ;
math.functions kernel splitting grouping columns ;
IN: math.fft
: n^v ( n v -- w ) [ ^ ] with map ;

View File

@ -1,5 +1,5 @@
! Haar wavelet transform -- http://dmr.ath.cx/gfx/haar/
USING: sequences math kernel splitting columns ;
USING: sequences math kernel splitting grouping columns ;
IN: math.haar
: averages ( seq -- seq )

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions math.parser namespaces
sequences splitting sequences.lib ;
sequences splitting grouping sequences.lib ;
IN: math.text.english
<PRIVATE

View File

@ -1,6 +1,6 @@
USING: io kernel math math.functions math.parser parser
namespaces sequences splitting combinators continuations
sequences.lib ;
namespaces sequences splitting grouping combinators
continuations sequences.lib ;
IN: money
: dollars/cents ( dollars -- dollars cents )

View File

@ -1,6 +1,6 @@
USING: kernel io parser words namespaces quotations arrays assocs sequences
splitting math shuffle ;
splitting grouping math shuffle ;
IN: mortar

View File

@ -1,7 +1,7 @@
USING: kernel namespaces
math math.constants math.functions math.matrices math.vectors
sequences splitting self math.trig ;
sequences splitting grouping self math.trig ;
IN: ori

View File

@ -1,6 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces project-euler.common sequences splitting ;
USING: kernel namespaces project-euler.common sequences
splitting grouping ;
IN: project-euler.011
! http://projecteuler.net/index.php?section=problems&id=11

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math
math.parser namespaces sequences sequences.lib sequences.private sorting
splitting strings sets ;
splitting grouping strings sets ;
IN: project-euler.059
! http://projecteuler.net/index.php?section=problems&id=59

View File

@ -1,5 +1,6 @@
USING: kernel math tools.test namespaces random
random.blum-blum-shub alien.c-types sequences splitting ;
random.blum-blum-shub alien.c-types sequences splitting
grouping ;
IN: blum-blum-shub.tests
[ 887708070 ] [

View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences vectors arrays generic assocs io math
namespaces parser prettyprint strings io.styles vectors words
system sorting splitting math.parser classes memory combinators ;
system sorting splitting grouping math.parser classes memory
combinators ;
IN: tools.memory
<PRIVATE

View File

@ -1,7 +1,7 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.vectors memory io io.styles prettyprint
namespaces system sequences splitting assocs strings ;
namespaces system sequences splitting grouping assocs strings ;
IN: tools.time
: benchmark ( quot -- runtime )

View File

@ -101,23 +101,15 @@ M: tree set-at ( value key tree -- )
: valid-tree? ( tree -- ? ) root>> valid-node? ;
: tree-call ( node call -- )
>r [ node-key ] keep node-value r> call ; inline
: find-node ( node quot -- key value ? )
{
{ [ over not ] [ 2drop f f f ] }
{ [ [
>r left>> r> find-node
] 2keep rot ]
[ 2drop t ] }
{ [ >r 2nip r> [ tree-call ] 2keep rot ]
[ drop [ node-key ] keep node-value t ] }
[ >r right>> r> find-node ]
} cond ; inline
: (node>alist) ( node -- )
[
[ left>> (node>alist) ]
[ [ node-key ] [ node-value ] bi 2array , ]
[ right>> (node>alist) ]
tri
] when* ;
M: tree assoc-find ( tree quot -- key value ? )
>r root>> r> find-node ;
M: tree >alist [ root>> (node>alist) ] { } make ;
M: tree clear-assoc
0 >>count

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: splitting classes.tuple classes math kernel sequences
arrays ;
USING: splitting grouping classes.tuple classes math kernel
sequences arrays ;
IN: tuple-arrays
TUPLE: tuple-array example ;

View File

@ -1,5 +1,5 @@
USING: kernel alien.c-types combinators sequences splitting
USING: kernel alien.c-types combinators sequences splitting grouping
opengl.gl ui.gadgets ui.render
math math.vectors accessors ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic kernel math namespaces sequences words
splitting math.vectors ui.gadgets.grids ui.gadgets ;
splitting grouping math.vectors ui.gadgets.grids ui.gadgets ;
IN: ui.gadgets.frames
! A frame arranges gadgets in a 3x3 grid, where the center

View File

@ -1,6 +1,6 @@
USING: io io.files splitting unicode.collation sequences kernel
io.encodings.utf8 math.parser math.order tools.test assocs
io.streams.null words combinators.lib ;
USING: io io.files splitting grouping unicode.collation
sequences kernel io.encodings.utf8 math.parser math.order
tools.test assocs io.streams.null words combinators.lib ;
IN: unicode.collation.tests
: parse-test ( -- strings )

View File

@ -1,5 +1,5 @@
USING: assocs math kernel sequences io.files hashtables
quotations splitting arrays math.parser hash2 math.order
quotations splitting grouping arrays math.parser hash2 math.order
byte-arrays words namespaces words compiler.units parser
io.encodings.ascii values interval-maps ascii sets assocs.lib
combinators.lib combinators locals math.ranges sorting ;

View File

@ -1,6 +1,7 @@
USING: alien alien.c-types kernel windows.ole32 combinators.lib
parser splitting sequences.lib sequences namespaces assocs
quotations shuffle accessors words macros alien.syntax fry ;
parser splitting grouping sequences.lib sequences namespaces
assocs quotations shuffle accessors words macros alien.syntax
fry ;
IN: windows.com.syntax
<PRIVATE