diff --git a/core/alien/syntax/syntax.factor b/core/alien/syntax/syntax.factor index b2e819f8fb..def5b02ba0 100755 --- a/core/alien/syntax/syntax.factor +++ b/core/alien/syntax/syntax.factor @@ -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 diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index d660436783..b33773cf9e 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -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 } } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 6b0798f2e3..15afce3e93 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -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 ; diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 183c7d1888..0187a6ce52 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -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 diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 4f4f2e10e1..9ffcd952e3 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -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 -- ) diff --git a/core/compiler/tests/stack-trace.factor b/core/compiler/tests/stack-trace.factor index 878f4230cd..3b1a5c6c85 100755 --- a/core/compiler/tests/stack-trace.factor +++ b/core/compiler/tests/stack-trace.factor @@ -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 diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 98194e7ef3..f58d016c22 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -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 [ - - ] [ - - ] if - ] bi - engine>quot + [ ] + bi engine>quot ] } cleave ] with-scope ; diff --git a/core/grouping/grouping-docs.factor b/core/grouping/grouping-docs.factor new file mode 100644 index 0000000000..08a54954e9 --- /dev/null +++ b/core/grouping/grouping-docs.factor @@ -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 } +{ $subsection } +"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:" +{ $subsection clumps } +{ $subsection } +{ $subsection } +"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 } " and " { $link } "." } +{ $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: +{ $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 dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" + } +} ; + +HELP: +{ $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 " + "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 } " and " { $link } "." } ; + +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: +{ $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 [ [ sum ] [ length ] bi / ] map ." + "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" + } +} ; + +HELP: +{ $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 + +{ } related-words + +{ } related-words diff --git a/core/grouping/grouping-tests.factor b/core/grouping/grouping-tests.factor new file mode 100644 index 0000000000..dcf62e1117 --- /dev/null +++ b/core/grouping/grouping-tests.factor @@ -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 + 2 over set-length + >array +] unit-test diff --git a/core/grouping/grouping.factor b/core/grouping/grouping.factor new file mode 100644 index 0000000000..c12d43160c --- /dev/null +++ b/core/grouping/grouping.factor @@ -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@ 0 swap copy ; + +M: abstract-groups like drop { } like ; + +INSTANCE: abstract-groups sequence + +TUPLE: groups < abstract-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 ; + +: ( seq n -- groups ) + sliced-groups new-groups ; inline + +M: sliced-groups nth group@ ; + +TUPLE: clumps < abstract-groups ; + +: ( 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 ; + +: ( seq n -- clumps ) + sliced-clumps new-groups ; inline + +M: sliced-clumps nth group@ ; + +: group ( seq n -- array ) { } like ; + +: clump ( seq n -- array ) { } like ; diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor index aff59ee8a5..e3b21e629e 100755 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -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 } -{ $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." } diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index ea2f67255c..a1dba07fb0 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -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 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)) pick set-hash-array + dup >alist + over hash-array length ((empty)) 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 [ set-at ] keep ; -M: hashtable assoc-find ( hash quot -- key value ? ) - >r hash-array r> find-pair ; +M: hashtable >alist + hash-array 2 [ first tombstone? not ] filter ; M: hashtable clone (clone) dup hash-array clone over set-hash-array ; diff --git a/core/math/bitfields/bitfields.factor b/core/math/bitfields/bitfields.factor index 77cc40180e..a0fb17ef48 100644 --- a/core/math/bitfields/bitfields.factor +++ b/core/math/bitfields/bitfields.factor @@ -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 ; diff --git a/core/prettyprint/prettyprint.factor b/core/prettyprint/prettyprint.factor index 1da7247a46..298fc83e9d 100755 --- a/core/prettyprint/prettyprint.factor +++ b/core/prettyprint/prettyprint.factor @@ -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 diff --git a/core/splitting/splitting-docs.factor b/core/splitting/splitting-docs.factor index 1beafc710a..028fa45de2 100644 --- a/core/splitting/splitting-docs.factor +++ b/core/splitting/splitting-docs.factor @@ -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 } -{ $subsection } -"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:" -{ $subsection clumps } -{ $subsection } -{ $subsection } -"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 } " and " { $link } "." } -{ $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: -{ $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 dup reverse-here concat >array ." "{ 6 7 8 3 4 5 0 1 2 }" - } -} ; - -HELP: -{ $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 " - "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 } " and " { $link } "." } ; - -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: -{ $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 [ [ sum ] [ length ] bi / ] map ." - "{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }" - } -} ; - -HELP: -{ $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 - -{ } related-words - -{ } 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 } "." } ; diff --git a/core/splitting/splitting-tests.factor b/core/splitting/splitting-tests.factor index 34757e6b22..0f3dbdea1b 100644 --- a/core/splitting/splitting-tests.factor +++ b/core/splitting/splitting-tests.factor @@ -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 - 2 over set-length - >array -] unit-test diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor index 62e7ef3782..c30ea462c1 100755 --- a/core/splitting/splitting.factor +++ b/core/splitting/splitting.factor @@ -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@ 0 swap copy ; - -M: abstract-groups like drop { } like ; - -INSTANCE: abstract-groups sequence - -TUPLE: groups < abstract-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 ; - -: ( seq n -- groups ) - sliced-groups construct-groups ; inline - -M: sliced-groups nth group@ ; - -TUPLE: clumps < abstract-groups ; - -: ( 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 ; - -: ( seq n -- clumps ) - sliced-clumps construct-groups ; inline - -M: sliced-clumps nth group@ ; - -: group ( seq n -- array ) { } like ; - -: clump ( seq n -- array ) { } like ; - : ?head ( seq begin -- newseq ? ) 2dup head? [ length tail t ] [ drop f ] if ; diff --git a/extra/base64/base64.factor b/extra/base64/base64.factor index 074640c536..600a8f4c3d 100644 --- a/extra/base64/base64.factor +++ b/extra/base64/base64.factor @@ -1,5 +1,5 @@ USING: kernel math sequences namespaces io.binary splitting - strings hashtables ; +grouping strings hashtables ; IN: base64 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 diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index 468a8cf253..f444f5a4f2 100644 --- a/extra/hexdump/hexdump.factor +++ b/extra/hexdump/hexdump.factor @@ -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 > 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 diff --git a/extra/tuple-arrays/tuple-arrays.factor b/extra/tuple-arrays/tuple-arrays.factor index 680610fbce..6a31dac808 100644 --- a/extra/tuple-arrays/tuple-arrays.factor +++ b/extra/tuple-arrays/tuple-arrays.factor @@ -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 ; diff --git a/extra/ui/gadgets/frame-buffer/frame-buffer.factor b/extra/ui/gadgets/frame-buffer/frame-buffer.factor index 4990254778..a288f74f64 100644 --- a/extra/ui/gadgets/frame-buffer/frame-buffer.factor +++ b/extra/ui/gadgets/frame-buffer/frame-buffer.factor @@ -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 ; diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor index daa7df6d8c..3e38f60627 100644 --- a/extra/ui/gadgets/frames/frames.factor +++ b/extra/ui/gadgets/frames/frames.factor @@ -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 diff --git a/extra/unicode/collation/collation-tests.factor b/extra/unicode/collation/collation-tests.factor index 16ac50d5a9..5de90d238d 100755 --- a/extra/unicode/collation/collation-tests.factor +++ b/extra/unicode/collation/collation-tests.factor @@ -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 ) diff --git a/extra/unicode/data/data.factor b/extra/unicode/data/data.factor index 125442e17f..e3dd15558b 100755 --- a/extra/unicode/data/data.factor +++ b/extra/unicode/data/data.factor @@ -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 ; diff --git a/extra/windows/com/syntax/syntax.factor b/extra/windows/com/syntax/syntax.factor index b63a5c3337..ac2b5122c0 100755 --- a/extra/windows/com/syntax/syntax.factor +++ b/extra/windows/com/syntax/syntax.factor @@ -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