]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/sequences/deep/deep.factor
core: subseq-index? -> subseq-of?
[factor.git] / basis / sequences / deep / deep.factor
index d748263b02f0e3395bc6716f429c59a3152e8bd7..9c1df0d31660f2cad577046e897385ad6026dfef 100644 (file)
@@ -1,6 +1,6 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel strings math fry ;
+USING: fry kernel make math sequences strings ;
 IN: sequences.deep
 
 ! All traversal goes in postorder
@@ -16,6 +16,9 @@ M: object branch? drop f ;
     [ call ] 2keep over branch?
     [ '[ _ deep-each ] each ] [ 2drop ] if ; inline recursive
 
+: deep-reduce ( ... obj identity quot: ( ... prev elt -- ... next ) -- ... result )
+    swapd deep-each ; inline
+
 : deep-map ( ... obj quot: ( ... elt -- ... elt' ) -- ... newobj )
     [ call ] keep over branch?
     [ '[ _ deep-map ] map ] [ drop ] if ; inline recursive
@@ -26,6 +29,12 @@ M: object branch? drop f ;
 : deep-filter ( ... obj quot: ( ... elt -- ... ? ) -- ... seq )
     over dup branch? [ drop f ] unless deep-filter-as ; inline
 
+: deep-reject-as ( ... obj quot: ( ... elt -- ... ? ) exemplar -- ... seq )
+    [ [ not ] compose ] dip deep-filter-as ; inline
+
+: deep-reject ( ... obj quot: ( ... elt -- ... ? ) -- ... seq )
+    [ not ] compose deep-filter ; inline
+
 : (deep-find) ( ... obj quot: ( ... elt -- ... ? ) -- ... elt ? )
     [ call ] 2keep rot [ drop t ] [
         over branch? [
@@ -45,9 +54,9 @@ M: object branch? drop f ;
         _ swap dup branch? [ member? ] [ 2drop f ] if
     ] deep-find >boolean ;
 
-: deep-subseq? ( subseq seq -- ? )
-    swap '[
-        _ swap dup branch? [ subseq? ] [ 2drop f ] if
+: deep-subseq-of? ( seq subseq -- ? )
+   '[
+        _ over branch? [ subseq-of? ] [ 2drop f ] if
     ] deep-find >boolean ;
 
 : deep-map! ( ... obj quot: ( ... elt -- ... elt' ) -- ... obj )
@@ -56,7 +65,16 @@ M: object branch? drop f ;
     ] [ drop ] if ; inline recursive
 
 : flatten ( obj -- seq )
-    [ branch? not ] deep-filter ;
+    [ branch? ] deep-reject ;
 
 : flatten-as ( obj exemplar -- seq )
-    [ branch? not ] swap deep-filter-as ;
+    [ branch? ] swap deep-reject-as ;
+
+: flatten1 ( obj -- seq )
+    [
+        [
+            dup branch? [
+                [ dup branch? [ % ] [ , ] if ] each
+            ] [ , ] if
+        ]
+    ] keep dup branch? [ drop f ] unless make ;