Factor out ``no-roots no-prefixes'' into its own word. Add load-root, 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

diff --git a/basis/present/present-tests.factor b/basis/present/present-tests.factor
index 96aa7b24f29f46f5ed6c493388bd606a2616f091..022ae9d6d92203f73cca69bb4043180c6683ad31 100644 (file)
--- a/basis/present/present-tests.factor
+++ b/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
\ No newline at end of file
+[ ] [ all-vocabs-recursive filter-vocabs [ present ] map drop ] unit-test

diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor
index e0a43927ba77d7b04829b29b922b22ac0259b4f6..c2265b298107cff6cfc0562f4042633a481fa52b 100644 (file)
--- a/basis/tools/completion/completion.factor
+++ b/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 ;

diff --git a/basis/vocabs/files/files.factor b/basis/vocabs/files/files.factor
index 1c3e3731bda0d1e6bf5c1f8158af90f6ff520097..4739fc80da7e1c61bb3a78fa6eaffc8acd4cbfef 100644 (file)
--- a/basis/vocabs/files/files.factor
+++ b/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 )

diff --git a/basis/vocabs/hierarchy/hierarchy-docs.factor b/basis/vocabs/hierarchy/hierarchy-docs.factor
index fee3fd30e03310619eaacb55a4bc54837b279195..09e3808e5a6f433bc26e6ee895a0352f9d4a14c2 100644 (file)
--- a/basis/vocabs/hierarchy/hierarchy-docs.factor
+++ b/basis/vocabs/hierarchy/hierarchy-docs.factor
@@ -1,13 +1,16 @@
-USING: help.markup help.syntax strings vocabs.loader ;\r
+USING: help.markup help.syntax strings vocabs.loader\r
+sequences ;\r
 IN: vocabs.hierarchy\r
 \r
 ARTICLE: "vocabs.hierarchy" "Vocabulary hierarchy tools"\r
-"These tools operate on all vocabularies found in the current set of " { $link vocab-roots } ", loaded or not."\r
+"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."\r
 $nl\r
 "Loading vocabulary hierarchies:"\r
 { $subsections\r
     load\r
     load-all\r
+    load-root\r
+    load-from-root\r
 }\r
 "Getting all vocabularies from disk:"\r
 { $subsections\r
@@ -23,6 +26,7 @@ $nl
 { $subsections\r
     no-roots\r
     no-prefixes\r
+    filter-vocabs\r
 }\r
 "Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"\r
 { $subsections\r
@@ -40,3 +44,14 @@ HELP: load
 HELP: load-all\r
 { $description "Load all vocabularies in the source tree." } ;\r
 \r
+HELP: load-from-root\r
+{ $values\r
+    { "root" "a vocaulary root" } { "prefix" string }\r
+}\r
+{ $description "Attempts to load all of the vocabularies with a certain prefix from a vocabulary root." } ;\r
+\r
+HELP: load-root\r
+{ $values\r
+    { "root" "a vocabulary root" }\r
+}\r
+{ $description "Attempts to load all of the vocabularies in a vocabulary root." } ;\r

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

diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor
index 6df810359d0d5babeb3088138be3c180c933d17c..c0995205e4286c4d2fa7bf7a8fa7436f91869179 100644 (file)
--- a/core/vocabs/loader/loader.factor
+++ b/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?
 

diff --git a/core/vocabs/vocabs-tests.factor b/core/vocabs/vocabs-tests.factor
index ec486e3a5ae02cb68a0c1eafda1d0c41c8391c3c..18e6b3710181154e194823bfe2812d17d65c0c76 100644 (file)
--- a/core/vocabs/vocabs-tests.factor
+++ b/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

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index f023472c6898e71177e76613f54f273ff88ef524..38881673e9877986398c0ca50684a627bca83a78 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/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 ;

diff --git a/extra/readline-listener/readline-listener.factor b/extra/readline-listener/readline-listener.factor
index 9f23b8ef36e842863b99cca70521f73a57c124b9..d1c418fecba5720026591276319b6f146e00c46a 100644 (file)
--- a/extra/readline-listener/readline-listener.factor
+++ b/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 ;