Add lazy-while and lazy-until to lazy-lists

diff --git a/extra/lazy-lists/authors.txt b/extra/lazy-lists/authors.txt
index 6d23bcac92115d3e04fd7e4752d4cacd9e4785d9..f6ba9ba80de7a7b51e0d2e480c95f7758fcc44a0 100644 (file)
--- 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 e8acb397df319c27362e96aa19781a1e99d8f407..b66eb6367fc65973822b302a7943cbd7504acadb 100644 (file)
--- 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 <lazy-subset> } " 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 <lazy-while> } " 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 <lazy-while> } " 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 c6294087045f64cc3ad9f748118fea88518ca00f..1fb7a18cba1e863b31aecbe9cd3dc29a572b9e51 100644 (file)
--- 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> lazy-until
+
+: luntil ( list quot -- result )
+  <lazy-until> ;
+
+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> lazy-while
+
+: lwhile ( list quot -- result )
+  <lazy-while>
+;
+
+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> lazy-subset