diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 3740382e58..a393cef7fa 100644 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -1,24 +1,49 @@ -USING: assocs io.files kernel namespaces sequences ; +USING: arrays assocs combinators.lib dlists io.files +kernel namespaces sequences shuffle vectors ; IN: io.paths -: find-file ( seq str -- path/f ) - [ - [ path+ exists? ] curry find nip - ] keep over [ path+ ] [ drop ] if ; +! HOOK: library-roots io-backend ( -- seq ) +! HOOK: binary-roots io-backend ( -- seq ) r path+ r> ] with* assoc-map ; : get-paths ( dir -- paths ) - dup directory keys append-path ; + dup directory append-path ; : (walk-dir) ( path -- ) - dup directory? [ - get-paths dup % [ (walk-dir) ] each + first2 [ + get-paths dup keys % [ (walk-dir) ] each ] [ drop ] if ; PRIVATE> -: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ; +: 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* ;