diff --git a/extra/lazy-lists/authors.txt b/extra/lazy-lists/authors.txt index 6d23bcac92..f6ba9ba80d 100644 --- a/extra/lazy-lists/authors.txt +++ b/extra/lazy-lists/authors.txt @@ -1,2 +1,3 @@ Chris Double +Samuel Tardieu Matthew Willis diff --git a/extra/lazy-lists/lazy-lists-docs.factor b/extra/lazy-lists/lazy-lists-docs.factor index e8acb397df..b66eb6367f 100644 --- a/extra/lazy-lists/lazy-lists-docs.factor +++ b/extra/lazy-lists/lazy-lists-docs.factor @@ -114,6 +114,16 @@ HELP: lsubset { $description "Perform a similar functionality to that of the " { $link subset } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } { $see-also leach lmap lmap-with ltake lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ; +HELP: lwhile +{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( X -- bool )" } { "result" "resulting cons object" } } +{ $description "Outputs a lazy list containing the first items in the list as long as " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } +{ $see-also luntil } ; + +HELP: luntil +{ $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( X -- bool )" } { "result" "resulting cons object" } } +{ $description "Outputs a lazy list containing the first items in the list until after " { $snippet "quot" } " evaluates to t. No evaluation of the list elements occurs initially but a " { $link } " object is returned with conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } +{ $see-also lwhile } ; + HELP: list>vector { $values { "list" "a cons object" } { "vector" "the list converted to a vector" } } { $description "Convert a list to a vector. If the list is a lazy infinite list then this will enter an infinite loop." } diff --git a/extra/lazy-lists/lazy-lists.factor b/extra/lazy-lists/lazy-lists.factor index c629408704..1fb7a18cba 100644 --- a/extra/lazy-lists/lazy-lists.factor +++ b/extra/lazy-lists/lazy-lists.factor @@ -206,6 +206,48 @@ M: lazy-take nil? ( lazy-take -- bool ) M: lazy-take list? ( object -- bool ) drop t ; +TUPLE: lazy-until cons quot ; + +C: lazy-until + +: luntil ( list quot -- result ) + ; + +M: lazy-until car ( lazy-until -- car ) + lazy-until-cons car ; + +M: lazy-until cdr ( lazy-until -- cdr ) + [ lazy-until-cons uncons ] keep lazy-until-quot + rot over call [ 2drop nil ] [ luntil ] if ; + +M: lazy-until nil? ( lazy-until -- bool ) + lazy-until-cons nil? ; + +M: lazy-until list? ( lazy-until -- bool ) + drop t ; + +TUPLE: lazy-while cons quot ; + +C: lazy-while + +: lwhile ( list quot -- result ) + +; + +M: lazy-while car ( lazy-while -- car ) + lazy-while-cons car ; + +M: lazy-while cdr ( lazy-while -- cdr ) + dup lazy-while-cons cdr dup nil? + [ 2drop nil ] [ swap lazy-while-quot lwhile ] if ; + +M: lazy-while nil? ( lazy-while -- bool ) + dup lazy-while-cons nil? + [ nip ] [ [ car ] keep lazy-while-quot call not ] if* ; + +M: lazy-while list? ( lazy-while -- bool ) + drop t ; + TUPLE: lazy-subset cons quot ; C: lazy-subset