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

vocabs.hierarchy: faster all-disk-vocabs-recursive. 

The old technique caused a high amount of redundant ``exists?`` checks,
even though we are traversing the directory tree.  That happens to be a
little slow on Windows, for some pathological reason, the first time
it's run. This should make it better while we also investigate why
``windows_stat`` is slower in that case.
flac
John Benediktsson 2020-02-09 09:04:14 -08:00 committed by Steve Ayerhart
parent 8a21ff40d3
commit 7c58cb88c5
No known key found for this signature in database
GPG Key ID: 5BFD39C5359E967D
1 changed files with 32 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
basis/vocabs/hierarchy/hierarchy.factor
View File

@ -14,22 +14,11 @@ M: vocab-prefix vocab-name name>> ;
<PRIVATE
: visible-dir? ( entry -- ? )
{ [ directory? ] [ name>> "." head? not ] } 1&& ;
: visible-dirs ( seq -- seq' )
[
{
[ directory? ]
[ name>> "." head? not ]
} 1&&
] filter ;
: vocab-subdirs ( dir -- dirs )
directory-entries visible-dirs [ name>> ] map! natural-sort ;
: vocab-dir? ( root name -- ? )
over
[ ".factor" append-vocab-dir append-path exists? ]
[ 2drop f ]
if ;
[ visible-dir? ] filter ;
ERROR: vocab-root-required root ;
@ -39,20 +28,36 @@ ERROR: vocab-root-required root ;
: ensure-vocab-root/prefix ( root prefix -- root prefix )
[ ensure-vocab-root ] [ check-vocab-name ] bi* ;
: (disk-vocab-children) ( root prefix -- vocabs )
check-vocab-name
[ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]
[ nip [ "." append '[ _ prepend ] map! ] unless-empty ]
[ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map! ]
2tri ;
: vocab-directory-entries ( root prefix -- vocab-path vocab-name entries )
[ ensure-vocab-root ] dip [ append-path ] keep
over dup exists? [ directory-entries ] [ drop { } ] if ;
: disk-vocabs-recursive% ( root prefix -- )
dupd vocab-name (disk-vocab-children) [ % ] keep
[ disk-vocabs-recursive% ] with each ;
: (disk-vocabs) ( root prefix -- seq )
vocab-directory-entries visible-dirs [ name>> ] sort-with [
name>>
[ dup ".factor" append append-path append-path ]
[ over empty? [ nip ] [ "." glue ] if ] bi-curry bi*
swap exists? [ >vocab-link ] [ <vocab-prefix> ] if
] 2with map ;
DEFER: add-vocab%
: add-vocab-children% ( vocab-path vocab-name entries -- )
visible-dirs [
name>>
[ append-path ]
[ over empty? [ nip ] [ "." glue ] if ] bi-curry bi*
over directory-entries add-vocab%
] 2with each ;
: add-vocab% ( vocab-path vocab-name entries -- )
3dup rot file-name ".factor" append '[ name>> _ = ] any?
[ >vocab-link ] [ <vocab-prefix> ] if , add-vocab-children% ;
: (disk-vocabs-recursive) ( root prefix -- seq )
[ ensure-vocab-root ] dip
[ disk-vocabs-recursive% ] { } make ;
vocab-directory-entries
[ add-vocab-children% ] { } make
[ name>> ] sort-with ;
: no-rooted ( seq -- seq' ) [ find-vocab-root ] reject ;
@ -77,7 +82,7 @@ PRIVATE>
no-roots no-prefixes members ;
: disk-vocabs-for-prefix ( prefix -- assoc )
[ [ vocab-roots get ] dip '[ dup _ (disk-vocab-children) ] { } map>assoc ]
[ [ vocab-roots get ] dip '[ dup _ (disk-vocabs) ] { } map>assoc ]
[ unrooted-disk-vocabs [ lookup-vocab ] map! f swap 2array ]
bi suffix ;