vocabs: change from errorlist to requiring list

[factor.git] / core / vocabs / vocabs.factor

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index 87ca67325a83708b649b37efb5e5fe65cc6fe4ab..a03ae103d918b4a158d066cd9bc6a2b5e2009c01 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs definitions kernel namespaces
-sequences sorting splitting strings ;
+USING: accessors arrays assocs definitions kernel namespaces
+sequences sets sorting splitting strings ;
 IN: vocabs
 
 SYMBOL: dictionary
@@ -11,10 +11,8 @@ name words
 main help
 source-loaded? docs-loaded? ;
 
-! sources-loaded? slot is one of these three
-SYMBOL: +parsing+
-SYMBOL: +running+
-SYMBOL: +done+
+! sources-loaded? and docs-loaded? slots could be
+SYMBOLS: +parsing+ +done+ ;
 
 : <vocab> ( name -- vocab )
     vocab new
@@ -33,6 +31,8 @@ C: <vocab-link> vocab-link
 
 UNION: vocab-spec vocab vocab-link ;
 
+INSTANCE: vocab-spec definition-mixin
+
 GENERIC: vocab-name ( vocab-spec -- name )
 
 M: vocab vocab-name name>> ;
@@ -76,6 +76,9 @@ M: object vocab-main lookup-vocab vocab-main ;
 
 M: f vocab-main ;
 
+PREDICATE: runnable-vocab < vocab
+    vocab-main >boolean ;
+
 SYMBOL: vocab-observers
 
 GENERIC: vocab-changed ( vocab obj -- )
@@ -150,10 +153,18 @@ M: vocab-spec forget* forget-vocab ;
 
 SYMBOL: require-hook
 
-PREDICATE: runnable-vocab < vocab
-    vocab-main >boolean ;
+<PRIVATE
 
-INSTANCE: vocab-spec definition-mixin
+SYMBOL: requiring
+
+: with-requiring ( quot -- )
+    requiring get [
+        call
+    ] [
+        HS{ } clone requiring [ call ] with-variable
+    ] if ; inline
+
+PRIVATE>
 
 GENERIC: require ( object -- )
 
@@ -167,8 +178,15 @@ M: vocab-link require name>> require ;
 ! that contain primitives, and loading the public vocabs would
 ! cause circularity issues.
 M: string require
-    [ ".private" ?tail ] keep swap [ lookup-vocab not ] when
-    [ require-hook get call( name -- ) ] [ drop ] if ;
+    [ ".private" ?tail ] keep swap [ lookup-vocab not ] when [
+        [
+            dup requiring get ?adjoin
+            [ require-hook get call( name -- ) ] [ drop ] if
+        ] with-requiring
+    ] [ drop ] if ;
+
+: require-all ( vocabs -- )
+    [ [ require ] each ] with-requiring ;
 
 : load-vocab ( name -- vocab )
     [ require ] [ lookup-vocab ] bi ;