From afe942130edef0def7e781587aa7fd7be85a403e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 11 Dec 2008 23:11:04 -0600
Subject: [PATCH] Add deep-member? and deep-subseq? to sequences.deep.

---
 basis/sequences/deep/authors.txt       |  1 +
 basis/sequences/deep/deep-tests.factor | 15 +++++++++++++++
 basis/sequences/deep/deep.factor       | 14 ++++++++++++--
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/basis/sequences/deep/authors.txt b/basis/sequences/deep/authors.txt
index f990dd0ed2..a07c427c98 100644
--- a/basis/sequences/deep/authors.txt
+++ b/basis/sequences/deep/authors.txt
@@ -1 +1,2 @@
 Daniel Ehrenberg
+Doug Coleman
diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor
index 522b5ecdf9..2d3260f427 100644
--- a/basis/sequences/deep/deep-tests.factor
+++ b/basis/sequences/deep/deep-tests.factor
@@ -24,3 +24,18 @@ IN: sequences.deep.tests
 [ "foo" ] [ "foo" [ string? ] deep-find ] unit-test
 
 [ { { 1 2 } 1 2 } ] [ [ { 1 2 } [ , ] deep-each ] { } make ] unit-test
+
+[ t ]
+[ { { 1 2 3 } 4 } { { { 1 { { 1 2 3 } 4 } } } 2 } deep-member? ] unit-test
+
+[ t ]
+[ { { 1 2 3 } 4 } { { { 1 2 3 } 4 } 2 } deep-member? ] unit-test
+
+[ f ]
+[ { 1 2 3 4 } { 1 2 3 { 4 } } deep-subseq? ] unit-test
+
+[ t ]
+[ { 1 2 3 4 } { 1 2 3 4 } deep-subseq? ] unit-test
+
+[ t ]
+[ { 1 2 3 4 } { { 1 2 3 4 } } deep-subseq? ] unit-test
diff --git a/basis/sequences/deep/deep.factor b/basis/sequences/deep/deep.factor
index db572681a1..244040d60a 100644
--- a/basis/sequences/deep/deep.factor
+++ b/basis/sequences/deep/deep.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2007 Daniel Ehrenberg
+! Copyright (C) 2007, 2008 Daniel Ehrenberg, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel strings math ;
+USING: sequences kernel strings math fry ;
 IN: sequences.deep
 
 ! All traversal goes in postorder
@@ -38,6 +38,16 @@ M: object branch? drop f ;
 : deep-all? ( obj quot -- ? )
     [ not ] compose deep-contains? not ; inline
 
+: deep-member? ( obj seq -- ? )
+    swap '[
+        _ swap dup branch? [ member? ] [ 2drop f ] if
+    ] deep-find >boolean ;
+
+: deep-subseq? ( subseq seq -- ? )
+    swap '[
+        _ swap dup branch? [ subseq? ] [ 2drop f ] if
+    ] deep-find >boolean ;
+
 : deep-change-each ( obj quot: ( elt -- elt' ) -- )
     over branch? [
         [ [ call ] keep over [ deep-change-each ] dip ] curry change-each