steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

change behavior of circular-while

db4
Doug Coleman 2009-12-07 19:27:36 -06:00
parent 7f1a643de2
commit 82f57e57f9
2 changed files with 10 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/circular/circular-docs.factor
View File

@ -50,7 +50,7 @@ HELP: rotate-circular
HELP: circular-while
{ $values
{ "sequence" sequence }
{ "circular" circular }
{ "quot" quotation }
}
{ $description "Calls " { $snippet "quot" } " on each element of the sequence until each call yields " { $link f } " in succession." } ;

24
basis/circular/circular.factor
View File

@ -59,27 +59,21 @@ PRIVATE>
TUPLE: circular-iterator
{ circular read-only } { n integer } { last-start integer } ;
: <circular-iterator> ( sequence -- obj )
<circular> 0 0 circular-iterator boa ; inline
: <circular-iterator> ( circular -- obj )
0 0 circular-iterator boa ; inline
<PRIVATE
: (circular-while) ( iterator quot: ( obj -- ? ) -- )
[ [ [ n>> ] [ circular>> ] bi nth ] dip call ] 2keep rot [
[
[ 1 + ] change-n
dup n>> >>last-start
] dip (circular-while)
[ [ [ n>> ] [ circular>> ] bi nth ] dip call ] 2keep
rot [ [ dup n>> >>last-start ] dip ] when
over [ n>> ] [ [ last-start>> ] [ circular>> length ] bi + 1 - ] bi = [
2drop
] [
over [ 1 + ] change-n
[ n>> ] [ [ last-start>> ] [ circular>> length ] bi + ] bi = [
2drop
] [
(circular-while)
] if
[ [ 1 + ] change-n ] dip (circular-while)
] if ; inline recursive
PRIVATE>
: circular-while ( sequence quot: ( obj -- ? ) -- )
[ <circular-iterator> ] dip (circular-while) ; inline
: circular-while ( circular quot: ( obj -- ? ) -- )
[ clone ] dip [ <circular-iterator> ] dip (circular-while) ; inline