diff --git a/basis/circular/circular-docs.factor b/basis/circular/circular-docs.factor index 8abadfadd2..b75f3ee2a1 100644 --- a/basis/circular/circular-docs.factor +++ b/basis/circular/circular-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax io.streams.string sequences -math kernel ; +math kernel quotations ; IN: circular HELP: @@ -33,12 +33,12 @@ HELP: circular HELP: growing-circular { $description "A circular sequence that is growable." } ; -HELP: push-circular +HELP: circular-push { $values { "elt" object } { "circular" circular } } { $description "Pushes an element to a " { $link circular } " object." } ; -HELP: push-growing-circular +HELP: growing-circular-push { $values { "elt" object } { "circular" circular } } { $description "Pushes an element onto a " { $link growing-circular } " object." } ; @@ -48,6 +48,13 @@ HELP: rotate-circular { "circular" circular } } { $description "Advances the start index of a circular object by one." } ; +HELP: circular-while +{ $values + { "sequence" sequence } + { "quot" quotation } +} +{ $description "Calls " { $snippet "quot" } " on each element of the sequence until each call yields yields " { $link f } " in succession." } ; + ARTICLE: "circular" "Circular sequences" "The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl "Creating a new circular object:" @@ -63,8 +70,10 @@ ARTICLE: "circular" "Circular sequences" } "Pushing new elements:" { $subsections - push-circular - push-growing-circular -} ; + circular-push + growing-circular-push +} +"Iterating over a circular until a stop condition:" +{ $subsections circular-while } ; ABOUT: "circular" diff --git a/basis/circular/circular-tests.factor b/basis/circular/circular-tests.factor index c3c4860f95..cda26df1d3 100644 --- a/basis/circular/circular-tests.factor +++ b/basis/circular/circular-tests.factor @@ -23,7 +23,7 @@ IN: circular.tests [ "boo" ] [ "foo" CHAR: b 3 pick set-nth-unsafe >string ] unit-test [ "ornact" ] [ "factor" 4 over change-circular-start CHAR: n 2 pick set-nth >string ] unit-test -[ "bcd" ] [ 3 "abcd" [ over push-circular ] each >string ] unit-test +[ "bcd" ] [ 3 "abcd" [ over circular-push ] each >string ] unit-test [ { 0 0 } ] [ { 0 0 } -1 over change-circular-start >array ] unit-test @@ -34,11 +34,11 @@ IN: circular.tests [ { } ] [ 3 >array ] unit-test [ { 1 2 } ] [ 3 - [ 1 swap push-growing-circular ] keep - [ 2 swap push-growing-circular ] keep >array + [ 1 swap growing-circular-push ] keep + [ 2 swap growing-circular-push ] keep >array ] unit-test [ { 3 4 5 } ] [ 3 dup { 1 2 3 4 5 } [ - swap push-growing-circular + swap growing-circular-push ] with each >array ] unit-test diff --git a/basis/circular/circular.factor b/basis/circular/circular.factor index 1c0efb1c36..67ddd3467b 100644 --- a/basis/circular/circular.factor +++ b/basis/circular/circular.factor @@ -1,57 +1,85 @@ ! Copyright (C) 2005, 2006 Alex Chapman, Daniel Ehrenberg ! See http;//factorcode.org/license.txt for BSD license USING: kernel sequences math sequences.private strings -accessors ; +accessors locals fry ; IN: circular -! a circular sequence wraps another sequence, but begins at an -! arbitrary element in the underlying sequence. -TUPLE: circular seq start ; +TUPLE: circular { seq read-only } { start integer } ; : ( seq -- circular ) - 0 circular boa ; + 0 circular boa ; inline > + ] keep [ seq>> length rem ] keep ; inline + PRIVATE> -M: circular length seq>> length ; +M: circular length seq>> length ; inline -M: circular virtual@ circular-wrap seq>> ; +M: circular virtual@ circular-wrap seq>> ; inline -M: circular virtual-exemplar seq>> ; +M: circular virtual-exemplar seq>> ; inline : change-circular-start ( n circular -- ) #! change start to (start + n) mod length - circular-wrap (>>start) ; + circular-wrap (>>start) ; inline : rotate-circular ( circular -- ) - [ 1 ] dip change-circular-start ; + [ 1 ] dip change-circular-start ; inline -: push-circular ( elt circular -- ) +: circular-push ( elt circular -- ) [ set-first ] [ rotate-circular ] bi ; : ( n -- circular ) - 0 ; + 0 ; inline INSTANCE: circular virtual-sequence TUPLE: growing-circular < circular length ; -M: growing-circular length length>> ; +M: growing-circular length length>> ; inline > length ] bi = ; + [ length ] [ seq>> length ] bi = ; inline PRIVATE> -: push-growing-circular ( elt circular -- ) - dup full? [ push-circular ] +: growing-circular-push ( elt circular -- ) + dup full? [ circular-push ] [ [ 1 + ] change-length set-last ] if ; : ( capacity -- growing-circular ) - { } new-sequence 0 0 growing-circular boa ; + { } new-sequence 0 0 growing-circular boa ; inline + +TUPLE: circular-iterator + { circular read-only } { n integer } { last-start integer } ; + +: ( sequence -- obj ) + 0 0 circular-iterator boa ; inline + +> ] [ circular>> ] bi nth ] dip call ] 2keep rot [ + [ + [ 1 + ] change-n + dup n>> >>last-start + ] dip (circular-while) + ] [ + over [ 1 + ] change-n + [ n>> ] [ [ last-start>> ] [ circular>> length ] bi + ] bi = [ + 2drop + ] [ + (circular-while) + ] if + ] if ; inline recursive + +PRIVATE> + +: circular-while ( sequence quot: ( obj -- ? ) -- ) + [ ] dip (circular-while) ; inline diff --git a/basis/sequences/parser/parser.factor b/basis/sequences/parser/parser.factor index 93bbbdf53d..44fa75239c 100644 --- a/basis/sequences/parser/parser.factor +++ b/basis/sequences/parser/parser.factor @@ -83,7 +83,7 @@ TUPLE: sequence-parser sequence n ; sequence length :> growing sequence-parser [ - current growing push-growing-circular + current growing growing-circular-push sequence growing sequence= ] take-until :> found growing sequence sequence= [ diff --git a/basis/xml/tokenize/tokenize.factor b/basis/xml/tokenize/tokenize.factor index b0dbdf22ac..beb5983b5a 100644 --- a/basis/xml/tokenize/tokenize.factor +++ b/basis/xml/tokenize/tokenize.factor @@ -86,7 +86,7 @@ HINTS: next* { spot } ; spot get '[ _ char>> blank? not ] skip-until ; : string-matches? ( string circular spot -- ? ) - char>> over push-circular sequence= ; + char>> over circular-push sequence= ; : take-string ( match -- string ) dup length @@ -147,7 +147,7 @@ HINTS: next* { spot } ; :: parse-text ( -- string ) 3 f :> circ depth get zero? :> no-text [| char | - char circ push-circular + char circ circular-push circ assure-no-]]> no-text [ char blank? char CHAR: < = or [ char 1string t pre/post-content diff --git a/extra/project-euler/186/186.factor b/extra/project-euler/186/186.factor index ed4f03dda1..922a28cb22 100644 --- a/extra/project-euler/186/186.factor +++ b/extra/project-euler/186/186.factor @@ -45,7 +45,7 @@ IN: project-euler.186 55 [1,b] [ (generator) ] map ; : advance ( lag -- ) - [ { 0 31 } swap nths sum 1000000 rem ] keep push-circular ; + [ { 0 31 } swap nths sum 1000000 rem ] keep circular-push ; : next ( lag -- n ) [ first ] [ advance ] bi ;