<PRIVATE
-: transfer-conditionals ( vocab-name record -- )
- {
- [ unloaded>> delete ]
- [ loaded>> adjoin ]
- [ swap partly-required get adjoin-at ]
- [ unloaded>> null? swap '[ _ require ] when ]
- } 2cleave ;
-
-: load-conditional-requires ( vocab-name -- )
- conditional-requires get
- [ dupd at members [ transfer-conditionals ] with each ]
- [ delete-at ] 2bi ;
+SYMBOL: require-when-vocabs
+require-when-vocabs [ HS{ } clone ] initialize
+
+SYMBOL: require-when-table
+require-when-table [ V{ } clone ] initialize
+
+: load-conditional-requires ( vocab -- )
+ vocab-name require-when-vocabs get in? [
+ require-when-table get [
+ [ [ vocab ] all? ] dip
+ '[ _ require ] when
+ ] assoc-each
+ ] when ;
: load-source ( vocab -- )
dup check-vocab-hook get call( vocab -- )
[ +parsing+ >>source-loaded? ] dip
[ % ] [ call( -- ) ] if-bootstrapping
+done+ >>source-loaded?
- vocab-name load-conditional-requires
+ load-conditional-requires
] [ ] [ f >>source-loaded? ] cleanup ;
: load-docs ( vocab -- )
: require ( vocab -- )
load-vocab drop ;
-<PRIVATE
-
-: adjoin-each-at ( elt seq assoc -- )
- [ swap ] dip '[ _ swap _ adjoin-at ] each ;
-
-: record-require-when ( then loaded unloaded -- )
- [ [ fast-set ] bi@ <require-when-record> ] 2keep
- [ conditional-requires get adjoin-each-at ]
- [ partly-required get adjoin-each-at ]
- bi-curry* bi ;
-
-PRIVATE>
-
: require-when ( if then -- )
- swap [ vocab ] partition
- [ drop require ] [ record-require-when ] if-empty ;
+ over [ vocab ] all? [
+ require drop
+ ] [
+ [ drop [ require-when-vocabs get adjoin ] each ]
+ [ 2array require-when-table get push ] 2bi
+ ] if ;
: reload ( name -- )
dup vocab
: check-vocab-name ( name -- name )
dup string? [ bad-vocab-name ] unless ;
-TUPLE: require-when-record
- vocab loaded unloaded ;
-
-! These are identified by their vocab
-M: require-when-record equal?
- over require-when-record?
- [ [ vocab>> ] bi@ = ] [ 2drop f ] if ;
-
-M: require-when-record hashcode*
- vocab>> hashcode* ;
-
-C: <require-when-record> require-when-record
-
-SYMBOL: conditional-requires
-conditional-requires [ H{ } clone ] initialize
-
-SYMBOL: partly-required
-partly-required [ H{ } clone ] initialize
-
: create-vocab ( name -- vocab )
check-vocab-name
dictionary get [ <vocab> ] cache
M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
-<PRIVATE
-
-: untransfer-conditionals ( vocab-name record -- )
- {
- [ loaded>> delete ]
- [ unloaded>> adjoin ]
- [ swap conditional-requires get adjoin-at ]
- } 2cleave ;
-
-: unload-conditional-requires ( vocab-name -- )
- partly-required get
- [ dupd at members [ untransfer-conditionals ] with each ]
- [ delete-at ] 2bi ;
-
-PRIVATE>
-
: forget-vocab ( vocab -- )
[ words forget-all ]
- [ vocab-name dictionary get delete-at ]
- [ unload-conditional-requires ] tri
+ [ vocab-name dictionary get delete-at ] bi
notify-vocab-observers ;
M: vocab-spec forget* forget-vocab ;