From 27245cd979c565c9491e5a94368119e910f5f63c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 25 Feb 2008 03:38:52 -0600
Subject: [PATCH] Clean up io.paths file search combinators

---
 extra/editors/editpadpro/editpadpro.factor |  2 +-
 extra/editors/gvim/windows/windows.factor  |  2 +-
 extra/io/paths/paths.factor                | 85 +++++++++++-----------
 3 files changed, 46 insertions(+), 43 deletions(-)
 mode change 100644 => 100755 extra/editors/gvim/windows/windows.factor
 mode change 100644 => 100755 extra/io/paths/paths.factor

diff --git a/extra/editors/editpadpro/editpadpro.factor b/extra/editors/editpadpro/editpadpro.factor
index 5a8168a181..eb31b2aa47 100755
--- a/extra/editors/editpadpro/editpadpro.factor
+++ b/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 -- )
diff --git a/extra/editors/gvim/windows/windows.factor b/extra/editors/gvim/windows/windows.factor
old mode 100644
new mode 100755
index e68bf04732..030c968e81
--- a/extra/editors/gvim/windows/windows.factor
+++ b/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* ;
diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor
old mode 100644
new mode 100755
index a393cef7fa..8980eacc3d
--- a/extra/io/paths/paths.factor
+++ b/extra/io/paths/paths.factor
@@ -1,49 +1,52 @@
-USING: arrays assocs combinators.lib dlists io.files
-kernel namespaces sequences shuffle vectors ;
+USING: io.files kernel sequences new-slots accessors
+dlists arrays ;
 IN: io.paths
 
-! HOOK: library-roots io-backend ( -- seq )
-! HOOK: binary-roots io-backend ( -- seq )
+TUPLE: directory-iterator path bfs queue ;
 
-<PRIVATE
-: append-path ( path files -- paths )
-    [ >r path+ r> ] with* assoc-map ;
+: qualified-directory ( path -- seq )
+    dup directory [ first2 >r path+ r> 2array ] with map ;
 
-: get-paths ( dir -- paths )
-    dup directory append-path ;
+: push-directory ( path iter -- )
+    >r qualified-directory r> [
+        dup queue>> swap bfs>>
+        [ push-front ] [ push-back ] if
+    ] curry each ;
 
-: (walk-dir) ( path -- )
-    first2 [
-        get-paths dup keys % [ (walk-dir) ] each
+: <directory-iterator> ( path bfs? -- iterator )
+    <dlist> directory-iterator construct-boa
+    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 ;
-PRIVATE>
+    ] keep ; inline
 
-: walk-dir ( path -- seq )
-    dup directory? 2array [ (walk-dir) ] { } make ;
-
-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* ;
+: recursive-directory ( path bfs? -- paths )
+    <directory-iterator>
+    [ dup next-file dup ] [ ] [ drop ] unfold nip ;