diff --git a/basis/circular/circular-docs.factor b/basis/circular/circular-docs.factor index 93d137d626..13934a1f91 100644 --- a/basis/circular/circular-docs.factor +++ b/basis/circular/circular-docs.factor @@ -55,6 +55,13 @@ HELP: circular-while } { $description "Calls " { $snippet "quot" } " on each element of the sequence until each call yields " { $link f } " in succession." } ; +HELP: circular-while* +{ $values + { "circular" circular } + { "quot" quotation } +} +{ $description "Calls " { $snippet "quot" } " on each element of the sequence until one call yields " { $link f } "." } ; + 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:" @@ -74,6 +81,6 @@ ARTICLE: "circular" "Circular sequences" growing-circular-push } "Iterating over a circular until a stop condition:" -{ $subsections circular-while } ; +{ $subsections circular-while circular-while* } ; ABOUT: "circular" diff --git a/basis/circular/circular-tests.factor b/basis/circular/circular-tests.factor index a3b1d5541c..dbc4678028 100644 --- a/basis/circular/circular-tests.factor +++ b/basis/circular/circular-tests.factor @@ -42,3 +42,9 @@ IN: circular.tests swap growing-circular-push ] with each >array ] unit-test + +[ V{ 1 2 3 1 2 } ] [ + { 1 2 3 } V{ } [ + [ [ push ] [ length 4 < ] bi ] curry circular-while + ] keep +] unit-test diff --git a/basis/circular/circular.factor b/basis/circular/circular.factor index f199413f86..1bd0c15995 100644 --- a/basis/circular/circular.factor +++ b/basis/circular/circular.factor @@ -77,3 +77,6 @@ PRIVATE> : circular-while ( ... circular quot: ( ... obj -- ... ? ) -- ... ) [ clone ] dip [ ] dip (circular-while) ; inline + +: circular-while* ( ... circular quot: ( ... obj -- ... ? ) -- ... ) + [ clone ] dip '[ [ first @ ] [ rotate-circular ] bi ] curry loop ; inline