sequences.product: adding product-find.

diff --git a/basis/sequences/product/product-docs.factor b/basis/sequences/product/product-docs.factor
index 36322fdd9cfdb35526b5fba5e4f218a8eaf321cc..29653555fddf3c6855401d50707e61712acbcaf8 100644 (file)
--- a/basis/sequences/product/product-docs.factor
+++ b/basis/sequences/product/product-docs.factor
@@ -58,7 +58,12 @@ HELP: product-each
 { $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } "." }
 { $notes { $snippet "[ ... ] product-each" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] each" } "." } ;
 
-{ product-map product-each } related-words
+HELP: product-find
+{ $values { "sequences" sequence } { "quot" { $quotation ( ... seq -- ... ? ) } } { "sequence" sequence } }
+{ $description "Calls " { $snippet "quot" } " for every element of the cartesian product of " { $snippet "sequences" } ", returning the first sequence where the quotation returns a true value." }
+{ $notes { $snippet "[ ... ] product-each" } " is equivalent to, but more efficient than, " { $snippet "<product-sequence> [ ... ] find" } "." } ;
+
+{ product-map product-each product-find } related-words
 
 ARTICLE: "sequences.product" "Product sequences"
 "The " { $vocab-link "sequences.product" } " vocabulary provides a virtual sequence and combinators for manipulating the cartesian product of a set of sequences."
@@ -69,6 +74,7 @@ ARTICLE: "sequences.product" "Product sequences"
     product-map-as
     product-map>assoc
     product-each
+    product-find
 } ;
 
 ABOUT: "sequences.product"

diff --git a/basis/sequences/product/product-tests.factor b/basis/sequences/product/product-tests.factor
index 5dfe79d04efc919cd48e60c5859339158515a9cb..06a65a7be8333ed6b935c80e098774343832d56b 100644 (file)
--- a/basis/sequences/product/product-tests.factor
+++ b/basis/sequences/product/product-tests.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Joe Groff.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel make sequences sequences.product tools.test ;
+USING: arrays kernel make math sequences sequences.product tools.test ;
 
 { { { 0 "a" } { 1 "a" } { 2 "a" } { 0 "b" } { 1 "b" } { 2 "b" } } }
 [ { { 0 1 2 } { "a" "b" } } <product-sequence> >array ] unit-test
@@ -24,3 +24,13 @@ USING: arrays kernel make sequences sequences.product tools.test ;
 
 { { } } [ { { } { 1 } } [ ] product-map ] unit-test
 { } [ { { } { 1 } } [ drop ] product-each ] unit-test
+
+{ { 2 4 8 } } [
+    { { 1 2 3 } { 4 5 6 } { 7 8 9 } }
+    [ [ even? ] all? ] product-find
+] unit-test
+
+{ f } [
+    { { 1 2 3 } { 4 5 6 } { 7 8 9 } }
+    [ [ 10 > ] all? ] product-find
+] unit-test

diff --git a/basis/sequences/product/product.factor b/basis/sequences/product/product.factor
index 9f0289b827aa826fdbcc4c63dd31a986d4d00fb7..f5e6c668bd0b5ad333d6db8bcf25dd98bd0b532a 100644 (file)
--- a/basis/sequences/product/product.factor
+++ b/basis/sequences/product/product.factor
@@ -78,3 +78,10 @@ M: product-sequence nth
         sequences [ quot call 2array i result set-nth-unsafe i 1 + i! ] product-each
         result
     ] new-like exemplar assoc-like ; inline
+
+:: product-find ( ... sequences quot: ( ... seq -- ... ? ) -- ... sequence )
+    sequences start-product-iter :> ( ns lengths )
+    lengths [ 0 = ] any? [
+        f [ ns lengths end-product-iter? over or ]
+        [ drop ns sequences nths quot keep and ns lengths product-iter ] until
+    ] unless ; inline