From 6be39382a3047577d9cf5fe8f35ec88201a0852a Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 13 Dec 2019 19:20:27 -0800
Subject: [PATCH] sequences: adding cartesian-find.

---
 core/sequences/sequences-docs.factor  | 5 +++++
 core/sequences/sequences-tests.factor | 3 +++
 core/sequences/sequences.factor       | 3 +++
 3 files changed, 11 insertions(+)

diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor
index 2404d2e17e..1ce18af8b2 100644
--- a/core/sequences/sequences-docs.factor
+++ b/core/sequences/sequences-docs.factor
@@ -1621,6 +1621,10 @@ HELP: assert-sequence=
   }
 } ;
 
+HELP: cartesian-find
+{ $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation ( ... elt1 elt2 -- ... ? ) } } { "elt1" object } { "elt2" object } }
+{ $description "Applies the quotation to every possible pairing of elements from the two sequences, returning the first two elements where the quotation returns a true value." } ;
+
 HELP: cartesian-each
 { $values { "seq1" sequence } { "seq2" sequence } { "quot" { $quotation ( ... elt1 elt2 -- ... ) } } }
 { $description "Applies the quotation to every possible pairing of elements from the two sequences." } ;
@@ -1981,6 +1985,7 @@ $nl
 { $subsections
     cartesian-each
     cartesian-map
+    cartesian-find
 }
 "Computing the cartesian product of two sequences:"
 { $subsections
diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor
index 72a326aaab..74320d76ba 100644
--- a/core/sequences/sequences-tests.factor
+++ b/core/sequences/sequences-tests.factor
@@ -363,6 +363,9 @@ M: bogus-hashcode hashcode* 2drop 0 >bignum ;
 { { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } }
 [ { 1 2 } { "a" "b" } cartesian-product ] unit-test
 
+{ 2 4 } [ { 1 2 3 } { 4 5 6 } [ [ even? ] both? ] cartesian-find ] unit-test
+{ f f } [ { 1 2 3 } { 4 5 6 } [ [ 10 > ] both? ] cartesian-find ] unit-test
+
 [ { } [ string>digits sum ] [ + ] map-reduce ] must-infer
 [ { } [ ] [ + ] map-reduce ] must-fail
 { 4 } [ { 1 1 } [ 1 + ] [ + ] map-reduce ] unit-test
diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index a711f645af..d0b2a7bc42 100644
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -1082,6 +1082,9 @@ M: repetition sum [ elt>> ] [ length>> ] bi * ; inline
 : cartesian-product ( seq1 seq2 -- newseq )
     [ { } 2sequence ] cartesian-map ;
 
+: cartesian-find ( ... seq1 seq2 quot: ( ... elt1 elt2 -- ... ? ) -- ... elt1 elt2 )
+    [ f ] 3dip [ with find swap ] 2curry [ nip ] prepose find nip swap ; inline
+
 <PRIVATE
 
 : select-by ( ... seq quot: ( ... elt -- ... x ) compare: ( obj1 obj2 -- ? ) -- ... elt )
-- 
2.34.1