Refactor vocab loader

core/vocabs/loader/loader-tests.factor

@@ -78,6 +78,8 @@ IN: vocabs.loader.tests
     ] with-compilation-unit
 ] unit-test
 
+[ f ] [ "vocabs.loader.test.b" vocab-files empty? ] unit-test
+
 [ ] [
     [
         "vocabs.loader.test.b" vocab-files
@@ -118,6 +120,13 @@ IN: vocabs.loader.tests
 [ { "resource:core/kernel/kernel.factor" 1 } ]
 [ "kernel" vocab where ] unit-test
 
+[ ] [
+    [
+        "vocabs.loader.test.c" forget-vocab
+        "vocabs.loader.test.d" forget-vocab
+    ] with-compilation-unit
+] unit-test
+
 [ t ] [
     [ "vocabs.loader.test.d" require ] [ :1 ] recover
     "vocabs.loader.test.d" vocab-source-loaded?

core/vocabs/loader/loader.factor

@@ -43,7 +43,7 @@ V{
     vocab-roots get swap [ vocab-dir? ] curry find nip ;
 
 M: string vocab-root
-    dup vocab [ vocab-root ] [ find-vocab-root ] ?if ;
+    vocab dup [ vocab-root ] when ;
 
 M: vocab-link vocab-root
     vocab-link-root ;
@@ -66,24 +66,22 @@ SYMBOL: load-help?
 : load-docs ( vocab -- )
     load-help? get [
         [ docs-weren't-loaded ] keep
-        [ vocab-docs-path ?run-file ] keep
+        [ vocab-docs-path [ ?run-file ] when* ] keep
         docs-were-loaded
     ] [ drop ] if ;
 
-: create-vocab-with-root ( vocab-link -- vocab )
+: create-vocab-with-root ( name root -- vocab )
-    dup vocab-name create-vocab
+    swap create-vocab [ set-vocab-root ] keep ;
-    swap vocab-root over set-vocab-root ;
+
+: update-root ( vocab -- )
+    dup vocab-root
+    [ drop ] [ dup find-vocab-root swap set-vocab-root ] if ;
 
 : reload ( name -- )
     [
-        f >vocab-link
+        dup vocab [
-        dup vocab-root [
+            dup update-root dup load-source load-docs
-            dup vocab-source-path resource-exists? [
+        ] [ no-vocab ] ?if
-                create-vocab-with-root
-                dup load-source
-                load-docs
-            ] [ no-vocab ] if
-        ] [ no-vocab ] if
     ] with-compiler-errors ;
 
 : require ( vocab -- )
@@ -100,33 +98,38 @@ SYMBOL: load-help?
 
 SYMBOL: blacklist
 
-GENERIC: (load-vocab) ( name -- vocab )
-
 : add-to-blacklist ( error vocab -- )
     vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
 
+GENERIC: (load-vocab) ( name -- )
+
 M: vocab (load-vocab)
-    [
+    dup update-root
-        dup vocab-root [
+
+    dup vocab-root [
+        [
             dup vocab-source-loaded? [ dup load-source ] unless
             dup vocab-docs-loaded? [ dup load-docs ] unless
-        ] when
+        ] [ [ swap add-to-blacklist ] keep rethrow ] recover
-    ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
+    ] when drop ;
 
 M: string (load-vocab)
-    [ ".private" ?tail drop reload ] keep vocab ;
+    ! ".private" ?tail drop
+    dup find-vocab-root >vocab-link (load-vocab) ;
 
 M: vocab-link (load-vocab)
-    vocab-name (load-vocab) ;
+    dup vocab-name swap vocab-root dup
+    [ create-vocab-with-root (load-vocab) ] [ 2drop ] if ;
 
 [
-    dup vocab-name blacklist get at* [
+    [
-        rethrow
+        dup vocab-name blacklist get at* [
-    ] [
+            rethrow
-        drop
+        ] [
-        [ dup vocab swap or (load-vocab) ] with-compiler-errors
+            drop
-    ] if
+            [ (load-vocab) ] with-compiler-errors
-
+        ] if
+    ] with-compiler-errors
 ] load-vocab-hook set-global
 
 : vocab-where ( vocab -- loc )

core/vocabs/vocabs.factor

@@ -15,8 +15,8 @@ source-loaded? docs-loaded? ;
 M: vocab equal? 2drop f ;
 
 : <vocab> ( name -- vocab )
-    H{ } clone t
+    H{ } clone
-    { set-vocab-name set-vocab-words set-vocab-source-loaded? }
+    { set-vocab-name set-vocab-words }
     \ vocab construct ;
 
 GENERIC: vocab ( vocab-spec -- vocab )
@@ -60,9 +60,16 @@ M: f vocab-help ;
 : create-vocab ( name -- vocab )
     dictionary get [ <vocab> ] cache ;
 
-SYMBOL: load-vocab-hook
+TUPLE: no-vocab name ;
 
-: load-vocab ( name -- vocab ) load-vocab-hook get call ;
+: no-vocab ( name -- * )
+    vocab-name \ no-vocab construct-boa throw ;
+
+SYMBOL: load-vocab-hook ! ( name -- )
+
+: load-vocab ( name -- vocab )
+    dup load-vocab-hook get call
+    dup vocab [ ] [ no-vocab ] ?if ;
 
 : vocabs ( -- seq )
     dictionary get keys natural-sort ;
@@ -115,8 +122,3 @@ UNION: vocab-spec vocab vocab-link ;
     vocab-name dictionary get delete-at ;
 
 M: vocab-spec forget* forget-vocab ;
-
-TUPLE: no-vocab name ;
-
-: no-vocab ( name -- * )
-    vocab-name \ no-vocab construct-boa throw ;

extra/bootstrap/help/help.factor

@@ -9,11 +9,10 @@ IN: bootstrap.help
 
     t load-help? set-global
 
-    [ vocab ] load-vocab-hook [
+    [ drop ] load-vocab-hook [
         vocabs
-        [ vocab-root ] subset
+        [ vocab-docs-loaded? not ] subset
-        [ vocab-source-loaded? ] subset
+        [ load-docs ] each
-        [ dup vocab-docs-loaded? [ drop ] [ load-docs ] if ] each
     ] with-variable ;
 
 load-help

extra/help/markup/markup.factor

@@ -158,7 +158,8 @@ M: f print-element drop ;
 : $subsection ( element -- )
     [ first ($long-link) ] ($subsection) ;
 
-: ($vocab-link) ( text vocab -- ) f >vocab-link write-link ;
+: ($vocab-link) ( text vocab -- )
+    dup vocab-root >vocab-link write-link ;
 
 : $vocab-subsection ( element -- )
     [

extra/tools/vocabs/vocabs.factor

@@ -19,16 +19,16 @@ IN: tools.vocabs
     ] [ drop ] if ;
 
 : vocab-tests ( vocab -- tests )
-    dup vocab-root [
+    dup vocab-root dup [
         [
-            f >vocab-link dup
+            >vocab-link dup
             vocab-tests-file,
             vocab-tests-dir,
         ] { } make
-    ] [ drop f ] if ;
+    ] [ 2drop f ] if ;
 
 : vocab-files ( vocab -- seq )
-    f >vocab-link [
+    dup find-vocab-root >vocab-link [
         dup vocab-source-path [ , ] when*
         dup vocab-docs-path [ , ] when*
         vocab-tests %