Clean up io.paths file search combinators

extra/editors/editpadpro/editpadpro.factor

@@ -6,7 +6,7 @@ IN: editors.editpadpro
 : editpadpro-path
     \ editpadpro-path get-global [
         program-files "JGsoft" path+
-        [ >lower "editpadpro.exe" tail? ] find-file-breadth
+        t [ >lower "editpadpro.exe" tail? ] find-file
     ] unless* ;
 
 : editpadpro ( file line -- )

extra/editors/gvim/windows/windows.factor

@@ -5,5 +5,5 @@ IN: editors.gvim.windows
 M: windows-io gvim-path
     \ gvim-path get-global [
         program-files "vim" path+
-        [ "gvim.exe" tail? ] find-file-breadth
+        t [ "gvim.exe" tail? ] find-file
     ] unless* ;

extra/io/paths/paths.factor

@@ -1,49 +1,52 @@
-USING: arrays assocs combinators.lib dlists io.files
+USING: io.files kernel sequences new-slots accessors
-kernel namespaces sequences shuffle vectors ;
+dlists arrays ;
 IN: io.paths
 
-! HOOK: library-roots io-backend ( -- seq )
+TUPLE: directory-iterator path bfs queue ;
-! HOOK: binary-roots io-backend ( -- seq )
 
-<PRIVATE
+: qualified-directory ( path -- seq )
-: append-path ( path files -- paths )
+    dup directory [ first2 >r path+ r> 2array ] with map ;
-    [ >r path+ r> ] with* assoc-map ;
 
-: get-paths ( dir -- paths )
+: push-directory ( path iter -- )
-    dup directory append-path ;
+    >r qualified-directory r> [
+        dup queue>> swap bfs>>
+        [ push-front ] [ push-back ] if
+    ] curry each ;
 
-: (walk-dir) ( path -- )
+: <directory-iterator> ( path bfs? -- iterator )
-    first2 [
+    <dlist> directory-iterator construct-boa
-        get-paths dup keys % [ (walk-dir) ] each
+    dup path>> over push-directory ;
+
+: next-file ( iter -- file/f )
+    dup queue>> dlist-empty? [ drop f ] [
+        dup queue>> pop-back first2
+        [ over push-directory next-file ] [ nip ] if
+    ] if ;
+
+: iterate-directory ( iter quot -- obj )
+    2dup >r >r >r next-file dup [
+        r> call dup [
+            r> r> 2drop
+        ] [
+            drop r> r> iterate-directory
+        ] if
     ] [
+        drop r> r> r> 3drop f
+    ] if ; inline
+
+: prepare-find-file ( path bfs? quot -- iter quot' )
+    >r <directory-iterator> r> [ keep and ] curry ; inline
+
+: find-file ( path bfs? quot -- path/f )
+    prepare-find-file iterate-directory ;
+
+: find-all-files ( path bfs? quot -- paths )
+    prepare-find-file V{ } clone [
+        [ over [ push ] [ 2drop ] if f ] curry compose
+        iterate-directory
         drop
-    ] if ;
+    ] keep ; inline
-PRIVATE>
 
-: walk-dir ( path -- seq )
+: recursive-directory ( path bfs? -- paths )
-    dup directory? 2array [ (walk-dir) ] { } make ;
+    <directory-iterator>
-
+    [ dup next-file dup ] [ ] [ drop ] unfold nip ;
-GENERIC# find-file* 1 ( obj quot -- path/f )
-
-M: dlist find-file* ( dlist quot -- path/f )
-    over dlist-empty? [ 2drop f ] [
-        2dup >r pop-front get-paths dup r> assoc-find
-        [ drop 3nip ]
-        [ 2drop [ nip ] assoc-subset keys pick push-all-back find-file* ] if
-    ] if ;
-
-M: vector find-file* ( vector quot -- path/f )
-    over empty? [ 2drop f ] [
-        2dup >r pop get-paths dup r> assoc-find
-        [ drop 3nip ]
-        [ 2drop [ nip ] assoc-subset keys pick push-all find-file* ] if
-    ] if ;
-
-: prepare-find-file ( quot -- quot )
-    [ drop ] swap compose ;
-
-: find-file-depth ( path quot -- path/f )
-    prepare-find-file >r 1vector r> find-file* ;
-
-: find-file-breadth ( path quot -- path/f )
-    prepare-find-file >r 1dlist r> find-file* ;