steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

io.directories.search: fix inline recursive combinator compilation. fix 

reversed logic for containing-directory
db4
Doug Coleman 2015-05-07 16:49:32 -07:00
parent 510f605df9
commit 2aa6ce7e8c
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
basis/io/directories/search/search.factor
View File

@ -109,19 +109,19 @@ ERROR: sequence-expected obj ;
[ file-info ] [ 2drop f ] recover ; [ file-info ] [ 2drop f ] recover ;
: containing-directory ( path -- path' ) : containing-directory ( path -- path' )
dup ?file-info directory? [ parent-directory ] when ; dup ?file-info directory? [ parent-directory ] unless ;
: ?qualified-directory-files ( path -- seq ) : ?qualified-directory-files ( path -- seq )
[ qualified-directory-files ] [ qualified-directory-files ]
[ drop ?parent-directory [ ?qualified-directory-files ] [ f ] if* ] recover ; [ drop ?parent-directory [ ?qualified-directory-files ] [ f ] if* ] recover ;
: (find-up-to-root) ( path quot -- obj ) : (find-up-to-root) ( path quot: ( path -- ? ) -- obj )
2dup [ ?qualified-directory-files ] dip find swap [ [ [ ?qualified-directory-files ] dip find swap ] 2keep rot [
2nip 2drop
] [ ] [
drop [ ?parent-directory ] dip over [ nip ?parent-directory ] dip over
[ (find-up-to-root) ] [ 2drop f ] if [ (find-up-to-root) ] [ 2drop f ] if
] if ; inline ] if ; inline recursive
: find-up-to-root ( path quot -- obj ) : find-up-to-root ( path quot -- obj )
[ normalize-path containing-directory ] dip (find-up-to-root) ; inline [ normalize-path containing-directory ] dip (find-up-to-root) ; inline