Circularity between vocabularies no longer causes an infinite loop; loading a vocabulary like json or furnace no longer loads certain files twice

basis/bootstrap/help/help.factor

@@ -1,6 +1,6 @@
 USING: help help.topics help.syntax help.crossref
 help.definitions io io.files kernel namespaces vocabs sequences
-parser vocabs.loader ;
+parser vocabs.loader vocabs.loader.private accessors assocs ;
 IN: bootstrap.help
 
 : load-help ( -- )
@@ -10,8 +10,8 @@ IN: bootstrap.help
     t load-help? set-global
 
     [ drop ] load-vocab-hook [
-        vocabs
+        dictionary get values
-        [ vocab-docs-loaded? not ] filter
+        [ docs-loaded?>> not ] filter
         [ load-docs ] each
     ] with-variable ;
 

basis/tools/test/test.factor

@@ -49,7 +49,7 @@ SYMBOL: this-test
     [ drop t ] must-fail-with ;
 
 : (run-test) ( vocab -- )
-    dup vocab-source-loaded? [
+    dup vocab source-loaded?>> [
         vocab-tests [ run-file ] each
     ] [ drop ] if ;
 

basis/tools/vocabs/vocabs.factor

@@ -134,12 +134,12 @@ SYMBOL: modified-docs
             [
                 [
                     [ modified-sources ]
-                    [ vocab-source-loaded? ]
+                    [ vocab source-loaded?>> ]
                     [ vocab-source-path ]
                     tri (to-refresh)
                 ] [
                     [ modified-docs ]
-                    [ vocab-docs-loaded? ]
+                    [ vocab docs-loaded?>> ]
                     [ vocab-docs-path ]
                     tri (to-refresh)
                 ] bi
@@ -154,8 +154,8 @@ SYMBOL: modified-docs
 : do-refresh ( modified-sources modified-docs unchanged -- )
     unchanged-vocabs
     [
-        [ [ f swap set-vocab-source-loaded? ] each ]
+        [ [ vocab f >>source-loaded? drop ] each ]
-        [ [ f swap set-vocab-docs-loaded? ] each ] bi*
+        [ [ vocab f >>docs-loaded? drop ] each ] bi*
     ]
     [
         append prune

core/vocabs/loader/loader-docs.factor

@@ -1,4 +1,5 @@
-USING: vocabs help.markup help.syntax words strings io ;
+USING: vocabs vocabs.loader.private help.markup help.syntax
+words strings io ;
 IN: vocabs.loader
 
 ARTICLE: "vocabs.roots" "Vocabulary roots"

core/vocabs/loader/loader-tests.factor

@@ -51,7 +51,7 @@ IN: vocabs.loader.tests
 2 [
     [ "vocabs.loader.test.a" require ] must-fail
     
-    [ f ] [ "vocabs.loader.test.a" vocab-source-loaded? ] unit-test
+    [ f ] [ "vocabs.loader.test.a" vocab source-loaded?>> ] unit-test
     
     [ t ] [
         "resource:core/vocabs/loader/test/a/a.factor"
@@ -129,9 +129,9 @@ IN: vocabs.loader.tests
     ] with-compilation-unit
 ] unit-test
 
-[ t ] [
+[ +done+ ] [
     [ "vocabs.loader.test.d" require ] [ :1 ] recover
-    "vocabs.loader.test.d" vocab-source-loaded?
+    "vocabs.loader.test.d" vocab source-loaded?>>
 ] unit-test
 
 : forget-junk
@@ -156,3 +156,21 @@ forget-junk
 
 [ "vocabs.loader.test.e" require ]
 [ relative-overflow? ] must-fail-with
+
+0 "vocabs.loader.test.g" set-global
+
+[
+    "vocabs.loader.test.f" forget-vocab
+    "vocabs.loader.test.g" forget-vocab
+] with-compilation-unit
+
+[ ] [ "vocabs.loader.test.g" require ] unit-test
+
+[ 1 ] [ "vocabs.loader.test.g" get-global ] unit-test
+
+[
+    "vocabs.loader.test.h" forget-vocab
+    "vocabs.loader.test.i" forget-vocab
+] with-compilation-unit
+
+[ ] [ "vocabs.loader.test.h" require ] unit-test

core/vocabs/loader/loader.factor

@@ -19,24 +19,27 @@ V{
     vocab-name { { CHAR: . CHAR: / } } substitute ;
 
 : vocab-dir+ ( vocab str/f -- path )
-    >r vocab-name "." split r>
+    [ vocab-name "." split ] dip
-    [ >r dup peek r> append suffix ] when*
+    [ [ dup peek ] dip append suffix ] when*
     "/" join ;
 
 : vocab-dir? ( root name -- ? )
-    over [
+    over
-        ".factor" vocab-dir+ append-path exists?
+    [ ".factor" vocab-dir+ append-path exists? ]
-    ] [
+    [ 2drop f ]
-        2drop f
+    if ;
-    ] if ;
 
 SYMBOL: root-cache
 
 H{ } clone root-cache set-global
 
+<PRIVATE
+
 : (find-vocab-root) ( name -- path/f )
     vocab-roots get swap [ vocab-dir? ] curry find nip ;
 
+PRIVATE>
+
 : find-vocab-root ( vocab -- path/f )
     vocab-name dup root-cache get at [ ] [ (find-vocab-root) ] ?if ;
 
@@ -51,26 +54,37 @@ H{ } clone root-cache set-global
 
 SYMBOL: load-help?
 
-: load-source ( vocab -- vocab )
+ERROR: circular-dependency name ;
-    f over set-vocab-source-loaded?
-    [ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep
-    t swap set-vocab-source-loaded?
-    [ % ] [ assert-depth ] if-bootstrapping ;
 
-: load-docs ( vocab -- vocab )
+<PRIVATE
-    load-help? get [
-        f over set-vocab-docs-loaded?
-        [ vocab-docs-path [ ?run-file ] when* ] keep
-        t swap set-vocab-docs-loaded?
-    ] [ drop ] if ;
 
-: reload ( name -- )
+: load-source ( vocab -- )
     [
-        dup vocab [ [ load-source ] [ load-docs ] bi ] [ no-vocab ] ?if
+        +parsing+ >>source-loaded?
-    ] with-compiler-errors ;
+        dup vocab-source-path [ parse-file ] [ [ ] ] if*
+        [ % ] [ assert-depth ] if-bootstrapping
+        +done+ >>source-loaded? drop
+    ] [ ] [ f >>source-loaded? ] cleanup ;
+
+: load-docs ( vocab -- )
+    load-help? get [
+        [
+            +parsing+ >>docs-loaded?
+            [ vocab-docs-path [ ?run-file ] when* ] keep
+            +done+ >>docs-loaded?
+        ] [ ] [ f >>docs-loaded? ] cleanup
+    ] when drop ;
+
+PRIVATE>
 
 : require ( vocab -- )
-    load-vocab drop ;
+    [ load-vocab drop ] with-compiler-errors ;
+
+: reload ( name -- )
+    dup vocab
+    [ [ [ load-source ] [ load-docs ] bi ] with-compiler-errors ]
+    [ require ]
+    ?if ;
 
 : run ( vocab -- )
     dup load-vocab vocab-main [
@@ -81,6 +95,8 @@ SYMBOL: load-help?
         "To define one, refer to \\ MAIN: help" print
     ] ?if ;
 
+<PRIVATE
+
 SYMBOL: blacklist
 
 : add-to-blacklist ( error vocab -- )
@@ -90,9 +106,10 @@ GENERIC: (load-vocab) ( name -- )
 
 M: vocab (load-vocab)
     [
-        dup vocab-source-loaded? [ dup load-source ] unless
+        dup source-loaded?>> +parsing+ eq? [
-        dup vocab-docs-loaded? [ dup load-docs ] unless
+            dup source-loaded?>> [ dup load-source ] unless
-        drop
+            dup docs-loaded?>> [ dup load-docs ] unless
+        ] unless drop
     ] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
 
 M: vocab-link (load-vocab)
@@ -103,19 +120,17 @@ M: string (load-vocab)
 
 [
     [
-        dup vocab-name blacklist get at* [
+        dup vocab-name blacklist get at* [ rethrow ] [
-            rethrow
+            drop dup find-vocab-root
-        ] [
+            [ [ (load-vocab) ] with-compiler-errors ]
-            drop
+            [ dup vocab [ drop ] [ no-vocab ] if ]
-            dup find-vocab-root [
+            if
-                [ (load-vocab) ] with-compiler-errors
-            ] [
-                dup vocab [ drop ] [ no-vocab ] if
-            ] if
         ] if
     ] with-compiler-errors
 ] load-vocab-hook set-global
 
+PRIVATE>
+
 : vocab-where ( vocab -- loc )
     vocab-source-path dup [ 1 2array ] when ;
 

core/vocabs/loader/test/f/f.factor

@@ -0,0 +1,4 @@
+IN: vocabs.laoder.test.f
+USE: vocabs.loader
+
+"vocabs.loader.test.g" require

core/vocabs/loader/test/f/tags.txt

@@ -0,0 +1 @@
+unportable

core/vocabs/loader/test/g/g.factor

@@ -0,0 +1,4 @@
+IN: vocabs.loader.test.g
+USING: vocabs.loader.test.f namespaces ;
+
+global [ "vocabs.loader.test.g" inc ] bind

core/vocabs/loader/test/g/tags.txt

@@ -0,0 +1 @@
+unportable

core/vocabs/loader/test/h/h.factor

@@ -0,0 +1 @@
+USE: vocabs.loader.test.i

core/vocabs/loader/test/h/tags.txt

@@ -0,0 +1 @@
+unportable

core/vocabs/loader/test/i/i.factor

@@ -0,0 +1,2 @@
+IN: vocabs.loader.test.i
+USE: vocabs.loader.test.h

core/vocabs/loader/test/i/tags.txt

@@ -0,0 +1 @@
+unportable

core/vocabs/vocabs-docs.factor

@@ -53,14 +53,6 @@ HELP: vocab-words
 { $values { "vocab-spec" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
 { $description "Outputs the words defined in a vocabulary." } ;
 
-HELP: vocab-source-loaded?
-{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
-{ $description "Outputs if the source for this vocubulary has been loaded." } ;
-
-HELP: vocab-docs-loaded?
-{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
-{ $description "Outputs if the documentation for this vocubulary has been loaded." } ;
-
 HELP: words
 { $values { "vocab" string } { "seq" "a sequence of words" } }
 { $description "Outputs a sequence of words defined in the vocabulary, or " { $link f } " if no vocabulary with this name exists." } ;

core/vocabs/vocabs.factor

@@ -11,6 +11,11 @@ name words
 main help
 source-loaded? docs-loaded? ;
 
+! sources-loaded? slot is one of these two
+SYMBOL: +parsing+
+SYMBOL: +running+
+SYMBOL: +done+
+
 : <vocab> ( name -- vocab )
     \ vocab new
         swap >>name
@@ -52,42 +57,6 @@ M: object vocab-main vocab vocab-main ;
 
 M: f vocab-main ;
 
-GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
-
-M: vocab vocab-source-loaded? source-loaded?>> ;
-
-M: object vocab-source-loaded?
-    vocab vocab-source-loaded? ;
-
-M: f vocab-source-loaded? ;
-
-GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
-
-M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
-
-M: object set-vocab-source-loaded?
-    vocab set-vocab-source-loaded? ;
-
-M: f set-vocab-source-loaded? 2drop ;
-
-GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
-
-M: vocab vocab-docs-loaded? docs-loaded?>> ;
-
-M: object vocab-docs-loaded?
-    vocab vocab-docs-loaded? ;
-
-M: f vocab-docs-loaded? ;
-
-GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
-
-M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
-
-M: object set-vocab-docs-loaded?
-    vocab set-vocab-docs-loaded? ;
-
-M: f set-vocab-docs-loaded? 2drop ;
-
 : create-vocab ( name -- vocab )
     dictionary get [ <vocab> ] cache ;