99 lines
2.4 KiB
Factor
99 lines
2.4 KiB
Factor
! Copyright (C) 2007, 2009 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: arrays assocs combinators.short-circuit fry
|
|
io.directories io.files io.files.info io.pathnames kernel make
|
|
memoize namespaces sequences sorting splitting vocabs sets
|
|
vocabs.loader vocabs.metadata vocabs.errors ;
|
|
IN: vocabs.hierarchy
|
|
|
|
<PRIVATE
|
|
|
|
: vocab-subdirs ( dir -- dirs )
|
|
[
|
|
[
|
|
{ [ link-info directory? ] [ "." head? not ] } 1&&
|
|
] filter
|
|
] with-directory-files natural-sort ;
|
|
|
|
: (all-child-vocabs) ( root name -- vocabs )
|
|
[
|
|
vocab-dir append-path dup exists?
|
|
[ vocab-subdirs ] [ drop { } ] if
|
|
] keep
|
|
[ '[ [ _ "." ] dip 3append ] map ] unless-empty ;
|
|
|
|
: vocab-dir? ( root name -- ? )
|
|
over
|
|
[ ".factor" vocab-dir+ append-path exists? ]
|
|
[ 2drop f ]
|
|
if ;
|
|
|
|
: vocabs-in-dir ( root name -- )
|
|
dupd (all-child-vocabs) [
|
|
2dup vocab-dir? [ dup >vocab-link , ] when
|
|
vocabs-in-dir
|
|
] with each ;
|
|
|
|
PRIVATE>
|
|
|
|
: all-vocabs ( -- assoc )
|
|
vocab-roots get [
|
|
dup [ "" vocabs-in-dir ] { } make
|
|
] { } map>assoc ;
|
|
|
|
: all-vocabs-under ( prefix -- vocabs )
|
|
[
|
|
[ vocab-roots get ] dip '[ _ vocabs-in-dir ] each
|
|
] { } make ;
|
|
|
|
MEMO: all-vocabs-seq ( -- seq )
|
|
"" all-vocabs-under ;
|
|
|
|
<PRIVATE
|
|
|
|
: unrooted-child-vocabs ( prefix -- seq )
|
|
dup empty? [ CHAR: . suffix ] unless
|
|
vocabs
|
|
[ find-vocab-root not ] filter
|
|
[
|
|
vocab-name swap ?head CHAR: . rot member? not and
|
|
] with filter
|
|
[ vocab ] map ;
|
|
|
|
PRIVATE>
|
|
|
|
: all-child-vocabs ( prefix -- assoc )
|
|
vocab-roots get [
|
|
dup pick (all-child-vocabs) [ >vocab-link ] map
|
|
] { } map>assoc
|
|
swap unrooted-child-vocabs f swap 2array suffix ;
|
|
|
|
: all-child-vocabs-seq ( prefix -- assoc )
|
|
vocab-roots get swap '[
|
|
dup _ (all-child-vocabs)
|
|
[ vocab-dir? ] with filter
|
|
] map concat ;
|
|
|
|
<PRIVATE
|
|
|
|
: filter-unportable ( seq -- seq' )
|
|
[ vocab-name unportable? not ] filter ;
|
|
|
|
PRIVATE>
|
|
|
|
: (load) ( prefix -- failures )
|
|
all-vocabs-under
|
|
filter-unportable
|
|
require-all ;
|
|
|
|
: load ( prefix -- )
|
|
(load) load-failures. ;
|
|
|
|
: load-all ( -- )
|
|
"" load ;
|
|
|
|
MEMO: all-tags ( -- seq )
|
|
all-vocabs-seq [ vocab-tags ] gather natural-sort ;
|
|
|
|
MEMO: all-authors ( -- seq )
|
|
all-vocabs-seq [ vocab-authors ] gather natural-sort ; |