Factor out ``no-roots no-prefixes'' into its own word. Add load-root, load-from-root, vocabs-in-root and implement load in terms of load-from-root.

Add error checking for append-vocab-dir and (child-vocabs) in case someone tries to pass them the wrong parameters.
Rename: vocab-dir+ to append-vocab-dir
Document load-from-root and load-root

basis/present/present-tests.factor

@@ -5,4 +5,4 @@ USING: tools.test vocabs.hierarchy present math vocabs sequences kernel ;
 [ "Hi" ] [ "Hi" present ] unit-test
 [ "+" ] [ \ + present ] unit-test
 [ "kernel" ] [ "kernel" vocab present ] unit-test
-[ ] [ all-vocabs-recursive no-roots no-prefixes [ present ] map drop ] unit-test
+[ ] [ all-vocabs-recursive filter-vocabs [ present ] map drop ] unit-test

basis/tools/completion/completion.factor

@@ -90,7 +90,7 @@ PRIVATE>
     all-words name-completions ;
 
 : vocabs-matching ( str -- seq )
-    all-vocabs-recursive no-roots no-prefixes name-completions ;
+    all-vocabs-recursive filter-vocabs name-completions ;
 
 : chars-matching ( str -- seq )
     name-map keys dup zip completions ;

basis/vocabs/files/files.factor

@@ -5,7 +5,7 @@ sequences vocabs.loader ;
 IN: vocabs.files
 
 : vocab-tests-file ( vocab -- path )
-    dup "-tests.factor" vocab-dir+ vocab-append-path dup
+    dup "-tests.factor" append-vocab-dir vocab-append-path dup
     [ dup exists? [ drop f ] unless ] [ drop f ] if ;
 
 : vocab-tests-dir ( vocab -- paths )

basis/vocabs/hierarchy/hierarchy-docs.factor

@@ -1,13 +1,16 @@
-USING: help.markup help.syntax strings vocabs.loader ;
+USING: help.markup help.syntax strings vocabs.loader
+sequences ;
 IN: vocabs.hierarchy
 
 ARTICLE: "vocabs.hierarchy" "Vocabulary hierarchy tools"
-"These tools operate on all vocabularies found in the current set of " { $link vocab-roots } ", loaded or not."
+"These tools operate on all vocabularies found in the current set of " { $link vocab-roots } ", loaded or not. A prefix is the first part of a vocabulary name."
 $nl
 "Loading vocabulary hierarchies:"
 { $subsections
     load
     load-all
+    load-root
+    load-from-root
 }
 "Getting all vocabularies from disk:"
 { $subsections
@@ -23,6 +26,7 @@ $nl
 { $subsections
     no-roots
     no-prefixes
+    filter-vocabs
 }
 "Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"
 { $subsections
@@ -40,3 +44,14 @@ HELP: load
 HELP: load-all
 { $description "Load all vocabularies in the source tree." } ;
 
+HELP: load-from-root
+{ $values
+    { "root" "a vocaulary root" } { "prefix" string }
+}
+{ $description "Attempts to load all of the vocabularies with a certain prefix from a vocabulary root." } ;
+
+HELP: load-root
+{ $values
+    { "root" "a vocabulary root" }
+}
+{ $description "Attempts to load all of the vocabularies in a vocabulary root." } ;

basis/vocabs/hierarchy/hierarchy.factor

@@ -24,21 +24,30 @@ M: vocab-prefix vocab-name name>> ;
 
 : vocab-dir? ( root name -- ? )
     over
-    [ ".factor" vocab-dir+ append-path exists? ]
+    [ ".factor" append-vocab-dir append-path exists? ]
     [ 2drop f ]
     if ;
 
+ERROR: vocab-root-required root ;
+
+: ensure-vocab-root ( root -- root )
+    dup vocab-roots get member? [ vocab-root-required ] unless ;
+
+: ensure-vocab-root/prefix ( root prefix -- root prefix )
+    [ ensure-vocab-root ] [ forbid-absolute-path ] bi* ;
+
 : (child-vocabs) ( root prefix -- vocabs )
+    ensure-vocab-root/prefix
     [ 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 ;
 
-: ((child-vocabs-recursive)) ( root name -- )
+: ((child-vocabs-recursive)) ( root prefix -- )
     dupd vocab-name (child-vocabs)
     [ dup , ((child-vocabs-recursive)) ] with each ;
 
-: (child-vocabs-recursive) ( root name -- seq )
+: (child-vocabs-recursive) ( root prefix -- seq )
     [ ((child-vocabs-recursive)) ] { } make ;
 
 : no-rooted ( seq -- seq' ) [ find-vocab-root not ] filter ;
@@ -73,6 +82,9 @@ PRIVATE>
 
 : no-roots ( assoc -- seq ) values concat ;
 
+: filter-vocabs ( assoc -- seq )
+    no-roots no-prefixes members ;
+
 : child-vocabs ( prefix -- assoc )
     [ [ vocab-roots get ] dip '[ dup _ (child-vocabs) ] { } map>assoc ]
     [ unrooted-child-vocabs [ vocab ] map f swap 2array ]
@@ -90,27 +102,49 @@ MEMO: all-vocabs-recursive ( -- assoc )
     "" child-vocabs-recursive ;
 
 : all-vocab-names ( -- seq )
-    all-vocabs-recursive no-roots no-prefixes [ vocab-name ] map ;
+    all-vocabs-recursive filter-vocabs [ vocab-name ] map ;
 
 : child-vocab-names ( prefix -- seq )
-    child-vocabs no-roots no-prefixes [ vocab-name ] map ;
+    child-vocabs filter-vocabs [ vocab-name ] map ;
 
 <PRIVATE
 
 : collect-vocabs ( quot -- seq )
-    [ all-vocabs-recursive no-roots no-prefixes ] dip
+    [ all-vocabs-recursive filter-vocabs ] dip
     gather natural-sort ; inline
 
+: maybe-include-root/prefix ( root prefix -- vocab-link/f )
+    over [
+        [ find-vocab-root = ] keep swap
+    ] [
+        nip dup find-vocab-root
+    ] if [ >vocab-link ] [ drop f ] if ;
+
 PRIVATE>
 
-: (load) ( prefix -- failures )
-    [ child-vocabs-recursive no-roots no-prefixes ]
-    [ dup find-vocab-root [ >vocab-link prefix ] [ drop ] if ] bi
-    filter-don't-load
+: vocabs-in-root/prefix ( root prefix -- seq )
+    [ (child-vocabs-recursive) ]
+    [ maybe-include-root/prefix [ prefix ] when* ] 2bi ;
+
+: vocabs-in-root ( root -- seq )
+    "" vocabs-in-root/prefix ;
+
+: (load-from-root) ( root prefix -- failures )
+    vocabs-in-root/prefix
+    [ don't-load? not ] filter no-prefixes
     require-all ;
 
+: load-from-root ( root prefix -- )
+    (load-from-root) load-failures. ;
+
+: load-root ( root -- )
+    "" load-from-root ;
+
+: (load) ( prefix -- failures )
+    [ vocab-roots get ] dip '[ _ (load-from-root) ] map concat ;
+
 : load ( prefix -- )
-    (load) load-failures. ;
+    (load) [ load-failures. ] each ;
 
 : load-all ( -- )
     "" load ;

core/vocabs/loader/loader.factor

@@ -45,23 +45,28 @@ PRIVATE>
 : vocab-dir ( vocab -- dir )
     vocab-name { { CHAR: . CHAR: / } } substitute ;
 
-: vocab-dir+ ( vocab str/f -- path )
-    [ vocab-name "." split ] dip
+ERROR: absolute-path-forbidden path ;
+
+: forbid-absolute-path ( str -- str )
+    dup absolute-path? [ absolute-path-forbidden ] when ;
+
+: append-vocab-dir ( vocab str/f -- path )
+    [ vocab-name forbid-absolute-path "." split ] dip
     [ [ dup last ] dip append suffix ] when*
     "/" join ;
 
 : find-vocab-root ( vocab -- path/f )
     vocab-name dup root-cache get at
-    [ ] [ ".factor" vocab-dir+ find-root-for ] ?if ;
+    [ ] [ ".factor" append-vocab-dir find-root-for ] ?if ;
 
 : vocab-append-path ( vocab path -- newpath )
     swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
 
 : vocab-source-path ( vocab -- path/f )
-    dup ".factor" vocab-dir+ vocab-append-path ;
+    dup ".factor" append-vocab-dir vocab-append-path ;
 
 : vocab-docs-path ( vocab -- path/f )
-    dup "-docs.factor" vocab-dir+ vocab-append-path ;
+    dup "-docs.factor" append-vocab-dir vocab-append-path ;
 
 SYMBOL: load-help?
 

core/vocabs/vocabs-tests.factor

@@ -8,6 +8,3 @@ IN: vocabs.tests
 [ t ] [ "" "io.files" child-vocab? ] unit-test
 [ t ] [ "io" "io.files" child-vocab? ] unit-test
 [ f ] [ "io.files" "io" child-vocab? ] unit-test
-
-[ t ] [ "io.files" "io" parent-vocab? ] unit-test
-[ f ] [ "io" "io.files" parent-vocab? ] unit-test

core/vocabs/vocabs.factor

@@ -111,12 +111,6 @@ ERROR: no-vocab name ;
 : child-vocabs ( vocab -- seq )
     vocab-name vocabs [ child-vocab? ] with filter ;
 
-: parent-vocab? ( suffix name -- ? )
-    swap child-vocab? ;
-
-: parent-vocabs ( vocab -- seq )
-    vocab-name vocabs [ parent-vocab? ] with filter ;
-
 GENERIC: >vocab-link ( name -- vocab )
 
 M: vocab-spec >vocab-link ;

extra/readline-listener/readline-listener.factor

@@ -23,7 +23,7 @@ M: readline-reader prompt.
     all-words [ name>> ] map ;
 
 : vocab-names ( -- strs )
-    all-vocabs-recursive no-roots no-prefixes [ name>> ] map ;
+    all-vocabs-recursive filter-vocabs [ name>> ] map ;
 
 : prefixed-words ( prefix -- words )
     '[ _ head? ] word-names swap filter ;