vocabs.hierachy: redo with cleaner API
parent
6aaad1ea9f
commit
5484bd3241
|
@ -7,19 +7,18 @@ $nl
|
|||
"Loading vocabulary hierarchies:"
|
||||
{ $subsection load }
|
||||
{ $subsection load-all }
|
||||
"Getting all vocabularies on disk:"
|
||||
"Getting all vocabularies from disk:"
|
||||
{ $subsection all-vocabs }
|
||||
{ $subsection all-vocabs-seq }
|
||||
"Getting " { $link "vocabs.metadata" } " for all vocabularies on disk:"
|
||||
{ $subsection all-vocabs-recursive }
|
||||
"Getting all vocabularies from disk whose names which match a string prefix:"
|
||||
{ $subsection child-vocabs }
|
||||
{ $subsection child-vocabs-recursive }
|
||||
"Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"
|
||||
{ $subsection all-tags }
|
||||
{ $subsection all-authors } ;
|
||||
|
||||
ABOUT: "vocabs.hierarchy"
|
||||
|
||||
HELP: all-vocabs
|
||||
{ $values { "assoc" "an association list mapping vocabulary roots to sequences of vocabulary specifiers" } }
|
||||
{ $description "Outputs an association list of all vocabularies which have been loaded or are available for loading." } ;
|
||||
|
||||
HELP: load
|
||||
{ $values { "prefix" string } }
|
||||
{ $description "Load all vocabularies that match the provided prefix." }
|
||||
|
@ -28,6 +27,3 @@ HELP: load
|
|||
HELP: load-all
|
||||
{ $description "Load all vocabularies in the source tree." } ;
|
||||
|
||||
HELP: all-vocabs-under
|
||||
{ $values { "prefix" string } { "vocabs" "a sequence of vocabularies" } }
|
||||
{ $description "Return a sequence of vocab or vocab-links for each vocab matching the provided prefix. Unlike " { $link all-child-vocabs } " this word will return both loaded and unloaded vocabularies." } ;
|
||||
|
|
|
@ -1,11 +1,18 @@
|
|||
! Copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs combinators.short-circuit fry
|
||||
USING: accessors 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 ;
|
||||
RENAME: child-vocabs vocabs => vocabs:child-vocabs
|
||||
IN: vocabs.hierarchy
|
||||
|
||||
TUPLE: vocab-prefix name ;
|
||||
|
||||
C: <vocab-prefix> vocab-prefix
|
||||
|
||||
M: vocab-prefix vocab-name name>> ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: vocab-subdirs ( dir -- dirs )
|
||||
|
@ -15,74 +22,76 @@ IN: vocabs.hierarchy
|
|||
] 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 ;
|
||||
: (child-vocabs) ( root prefix -- vocabs )
|
||||
[ vocab-dir append-path dup exists? [ vocab-subdirs ] [ drop { } ] if ]
|
||||
[ nip [ '[ [ _ "." ] dip 3append ] map ] unless-empty ]
|
||||
[ drop '[ _ over vocab-dir? [ >vocab-link ] [ <vocab-prefix> ] if ] map ]
|
||||
2tri ;
|
||||
|
||||
PRIVATE>
|
||||
: ((child-vocabs-recursive)) ( root name -- )
|
||||
dupd vocab-name (child-vocabs)
|
||||
[ dup , ((child-vocabs-recursive)) ] with each ;
|
||||
|
||||
: all-vocabs ( -- assoc )
|
||||
vocab-roots get [
|
||||
dup [ "" vocabs-in-dir ] { } make
|
||||
] { } map>assoc ;
|
||||
: (child-vocabs-recursive) ( root name -- seq )
|
||||
[ ((child-vocabs-recursive)) ] { } make ;
|
||||
|
||||
: all-vocabs-under ( prefix -- vocabs )
|
||||
[
|
||||
[ vocab-roots get ] dip '[ _ vocabs-in-dir ] each
|
||||
] { } make ;
|
||||
: no-rooted ( seq -- seq' ) [ find-vocab-root not ] filter ;
|
||||
|
||||
MEMO: all-vocabs-seq ( -- seq )
|
||||
"" all-vocabs-under ;
|
||||
|
||||
<PRIVATE
|
||||
: one-level-only? ( name prefix -- ? )
|
||||
?head [ "." split1 nip not ] dip and ;
|
||||
|
||||
: unrooted-child-vocabs ( prefix -- seq )
|
||||
[ vocabs no-rooted ] dip
|
||||
dup empty? [ CHAR: . suffix ] unless
|
||||
vocabs
|
||||
[ find-vocab-root not ] filter
|
||||
[
|
||||
vocab-name swap ?head CHAR: . rot member? not and
|
||||
] with filter
|
||||
[ vocab ] map ;
|
||||
'[ vocab-name _ one-level-only? ] filter ;
|
||||
|
||||
: unrooted-child-vocabs-recursive ( prefix -- seq )
|
||||
vocabs:child-vocabs no-rooted ;
|
||||
|
||||
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 ;
|
||||
: no-prefixes ( seq -- seq' ) [ vocab-prefix? not ] filter ;
|
||||
|
||||
: all-child-vocabs-seq ( prefix -- assoc )
|
||||
vocab-roots get swap '[
|
||||
dup _ (all-child-vocabs)
|
||||
[ vocab-dir? ] with filter
|
||||
] map concat ;
|
||||
: no-roots ( assoc -- seq ) values concat ;
|
||||
|
||||
: child-vocabs ( prefix -- assoc )
|
||||
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ]
|
||||
[ unrooted-child-vocabs [ vocab ] map f swap 2array ]
|
||||
bi suffix ;
|
||||
|
||||
: all-vocabs ( -- assoc )
|
||||
"" child-vocabs ;
|
||||
|
||||
: child-vocabs-recursive ( prefix -- assoc )
|
||||
[ [ vocab-roots get ] dip '[ dup _ (child-vocabs-recursive) ] { } map>assoc ]
|
||||
[ unrooted-child-vocabs-recursive [ vocab ] map f swap 2array ]
|
||||
bi suffix ;
|
||||
|
||||
MEMO: all-vocabs-recursive ( -- assoc )
|
||||
"" child-vocabs-recursive ;
|
||||
|
||||
: all-vocab-names ( -- seq )
|
||||
all-vocabs-recursive no-roots no-prefixes [ vocab-name ] map ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: filter-unportable ( seq -- seq' )
|
||||
[ vocab-name unportable? not ] filter ;
|
||||
|
||||
: collect-vocabs ( quot -- seq )
|
||||
[ all-vocabs-recursive no-roots no-prefixes ] dip
|
||||
gather natural-sort ; inline
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: (load) ( prefix -- failures )
|
||||
all-vocabs-under
|
||||
child-vocabs-recursive
|
||||
filter-unportable
|
||||
require-all ;
|
||||
|
||||
|
@ -92,8 +101,6 @@ PRIVATE>
|
|||
: load-all ( -- )
|
||||
"" load ;
|
||||
|
||||
MEMO: all-tags ( -- seq )
|
||||
all-vocabs-seq [ vocab-tags ] gather natural-sort ;
|
||||
MEMO: all-tags ( -- seq ) [ vocab-tags ] collect-vocabs ;
|
||||
|
||||
MEMO: all-authors ( -- seq )
|
||||
all-vocabs-seq [ vocab-authors ] gather natural-sort ;
|
||||
MEMO: all-authors ( -- seq ) [ vocab-authors ] collect-vocabs ;
|
||||
|
|
Loading…
Reference in New Issue