lazy-lists: add lmerge

diff --git a/contrib/lazy-lists/lists.factor b/contrib/lazy-lists/lists.factor
index 26fcfd9fba7f76460f995952a799fbe81db14de4..d78162f660761fb8331c29ed1d6615e633380806 100644 (file)
--- a/contrib/lazy-lists/lists.factor
+++ b/contrib/lazy-lists/lists.factor
@@ -422,3 +422,21 @@ M: lazy-concat list? ( object -- bool )
 
 : lcomp* ( list guards quot -- result )
   >r >r lcartesian-product* r> [ lsubset ] each r> lmap ;
+
+DEFER: lmerge
+
+: (lmerge) ( list1 list2 -- result )
+  over [ car ] curry -rot 
+  [ 
+    dup [ car ] curry -rot
+    [
+      >r cdr r> cdr lmerge
+    ] curry curry lazy-cons       
+  ] curry curry lazy-cons ;
+
+: lmerge ( list1 list2 -- result ) 
+  {
+    { [ over nil? ] [ nip   ] }
+    { [ dup nil?  ]  [ drop ] }
+    { [ t         ]  [ (lmerge) ] }
+  } cond ;
\ No newline at end of file

diff --git a/contrib/lazy-lists/lists.facts b/contrib/lazy-lists/lists.facts
index c7b4d4de7dfc4cf1283b889f1ae98319c96f2680..9543fb780ddd7e00ec1e2f0bf212a8026d62704d 100644 (file)
--- a/contrib/lazy-lists/lists.facts
+++ b/contrib/lazy-lists/lists.facts
@@ -111,27 +111,27 @@ HELP: uncons
 HELP: leach
 { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- )" } }
 { $description "Call the quotation for each item in the list." } 
-{ $see-also lmap lmap-with ltake lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also lmap lmap-with ltake lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lmap
 { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj -- X )" } { "result" "resulting cons object" } }
 { $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-map> } " 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 ltake lsubset lappend lmap-with  lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach ltake lsubset lappend lmap-with  lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lmap-with
 { $values { "value" "an object" } { "list" "a cons object" } { "quot" "a quotation with stack effect ( obj elt -- X )" } { "result" "resulting cons object" } }
 { $description "Variant of " { $link lmap } " which pushes a retained object on each invocation of the quotation." } 
-{ $see-also leach ltake lsubset lappend lmap lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach ltake lsubset lappend lmap lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: ltake
 { $values { "n" "a non negative integer" } { "list" "a cons object" } { "result" "resulting cons object" } }
 { $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-take> } " 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 lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with lsubset lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lsubset
 { $values { "list" "a cons object" } { "quot" "a quotation with stack effect ( -- X )" } { "result" "resulting cons object" } }
 { $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* } ;
+{ $see-also leach lmap lmap-with ltake lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: list>vector
 { $values { "list" "a cons object" } { "vector" "the list converted to a vector" } }
@@ -146,17 +146,17 @@ HELP: list>array
 HELP: lappend
 { $values { "list1" "a cons object" } { "list2" "a cons object" } { "result" "a lazy list of list2 appended to list1" } }
 { $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-append> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } 
-{ $see-also leach lmap lmap-with ltake lsubset lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with ltake lsubset lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lfrom-by
 { $values { "n" "an integer" } { "quot" "a quotation with stack effect ( -- int )" } { "result" "a lazy list of integers" } }
 { $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } 
-{ $see-also leach lmap lmap-with ltake lsubset lfrom lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with ltake lsubset lfrom lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lfrom
 { $values { "n" "an integer" } { "result" "a lazy list of integers" } }
 { $description "Return an infinite lazy list of incrementing integers starting from n." } 
-{ $see-also leach lmap lmap-with ltake lsubset lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with ltake lsubset lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: seq>list
 { $values { "index" "an integer 0 or greater" } { "seq" "a sequence" } { "list" "a list" } }
@@ -171,22 +171,22 @@ HELP: >list
 HELP: lconcat
 { $values { "list" "a list of lists" } { "result" "a list" } }
 { $description "Concatenates a list of lists together into one list." } 
-{ $see-also leach lmap lmap-with ltake lsubset lcartesian-product lcartesian-product* lfrom-by lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with ltake lsubset lcartesian-product lcartesian-product* lfrom-by lcomp lcomp* lmerge } ;
 
 HELP: lcartesian-product
 { $values { "list1" "a list" } { "list2" "a list" } { "result" "list of cartesian products" } }
 { $description "Given two lists, return a list containing the cartesian product of those lists." } 
-{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product* lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product* lcomp lcomp* lmerge } ;
 
 HELP: lcartesian-product*
 { $values { "list" "a list of lists" } { "result" "list of cartesian products" } }
 { $description "Given a list of lists, return a list containing the cartesian product of those lists." } 
-{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp lcomp* } ;
+{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp lcomp* lmerge } ;
 
 HELP: lcomp
 { $values { "list" "a list of lists" } { "quot" "a quotation with stack effect ( seq -- X )" } { "list" "the resulting list" } }
 { $description "Get the cartesian product of the lists in 'list' and call 'quot' call with each element from the cartesian product on the stack, the result of which is returned in the final 'list'." } 
-{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp* } ;
+{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp* lmerge } ;
 
 HELP: lcomp*
 { $values { "list" "a list of lists" } { "guards" "a sequence of quotations with stack effect ( seq -- bool )" } { "quot" "a quotation with stack effect ( seq -- X )" } { "list" "the resulting list" } }
@@ -194,5 +194,13 @@ HELP: lcomp*
 { $examples
   { $example "{ 1 2 3 } >list { 4 5 6 } >list 2list { [ first odd? ] } [ first2 + ] lcomp*" }
 }
+{ $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp lmerge } ;
+
+HELP: lmerge
+{ $values { "list1" "a list" } { "list2" "a list" } { "result" "lazy list merging list1 and list2" } }
+{ $description "Return the result of merging the two lists in a lazy manner." } 
+{ $examples
+  { $example "{ 1 2 3 } >list { 4 5 6 } >list lmerge list>array\n => { 1 4 2 5 3 6 }" }
+}
 { $see-also leach lmap lmap-with lconcat ltake lsubset lfrom-by lcartesian-product lcomp } ;