diff --git a/basis/sequences/product/product-docs.factor b/basis/sequences/product/product-docs.factor index 36322fdd9c..29653555fd 100644 --- 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 " [ ... ] 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 " [ ... ] 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 5dfe79d04e..06a65a7be8 100644 --- 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" } } >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 9f0289b827..f5e6c668bd 100644 --- 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