! 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
"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 }
$nl
"The standard functional programming idioms:"
{ $subsection assoc-each }
+{ $subsection assoc-find }
{ $subsection assoc-map }
{ $subsection assoc-push-if }
{ $subsection assoc-filter }
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 } }
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
: 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 ;
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
#! 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 -- )
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
"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 ;
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+! 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 ;
$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 } ;
{ $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." }
-! 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
: 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
[ 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 ]
[ 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) ;
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) ;
: 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 ;
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 ;
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
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 }
{ $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 } "." } ;
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
[ { "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
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 ;
USING: kernel math sequences namespaces io.binary splitting
- strings hashtables ;
+grouping strings hashtables ;
IN: base64
<PRIVATE
-USING: namespaces math sequences splitting kernel columns ;
+USING: namespaces math sequences splitting grouping
+kernel columns ;
IN: benchmark.dispatch2
: sequences ( -- seq )
-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 )
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 )
! 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
-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
-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
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
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
! 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
! 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
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
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
<< {
! 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 ;
! 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 )
! 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
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 )
USING: kernel io parser words namespaces quotations arrays assocs sequences
- splitting math shuffle ;
+ splitting grouping math shuffle ;
IN: mortar
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
! 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
! 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
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 ] [
! 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
! 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 )
: 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
-
-M: tree assoc-find ( tree quot -- key value ? )
- >r root>> r> find-node ;
+: (node>alist) ( node -- )
+ [
+ [ left>> (node>alist) ]
+ [ [ node-key ] [ node-value ] bi 2array , ]
+ [ right>> (node>alist) ]
+ tri
+ ] when* ;
+
+M: tree >alist [ root>> (node>alist) ] { } make ;
M: tree clear-assoc
0 >>count
! 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 ;
-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 ;
! 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
-USING: io io.files splitting unicode.collation sequences kernel\r
-io.encodings.utf8 math.parser math.order tools.test assocs\r
-io.streams.null words combinators.lib ;\r
+USING: io io.files splitting grouping unicode.collation\r
+sequences kernel io.encodings.utf8 math.parser math.order\r
+tools.test assocs io.streams.null words combinators.lib ;\r
IN: unicode.collation.tests\r
\r
: parse-test ( -- strings )\r
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 ;
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
projects / factor.git / commitdiff