 
 <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 ;
 

    no-roots no-prefixes members ;

: disk-vocabs-for-prefix ( prefix -- assoc )
    [ [ vocab-roots get ] dip '[ dup _ (disk-vocab-children) ] { } map>assoc ]
    [ unrooted-disk-vocabs [ lookup-vocab ] map! f swap 2array ]
    bi suffix ;


: ensure-vocab-root/prefix ( root prefix -- root prefix )
    [ ensure-vocab-root ] [ check-vocab-name ] bi* ;

: 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) ( 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 )
    vocab-directory-entries
    [ add-vocab-children% ] { } make
    [ name>> ] sort-with ;

: no-rooted ( seq -- seq' ) [ find-vocab-root ] reject ;

