Fixing require-when
parent
00176e7bd1
commit
099ffa1f5e
|
@ -66,18 +66,19 @@ DEFER: require
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: transfer-conditionals ( vocab-name record -- )
|
SYMBOL: require-when-vocabs
|
||||||
{
|
require-when-vocabs [ HS{ } clone ] initialize
|
||||||
[ unloaded>> delete ]
|
|
||||||
[ loaded>> adjoin ]
|
|
||||||
[ swap partly-required get adjoin-at ]
|
|
||||||
[ unloaded>> null? swap '[ _ require ] when ]
|
|
||||||
} 2cleave ;
|
|
||||||
|
|
||||||
: load-conditional-requires ( vocab-name -- )
|
SYMBOL: require-when-table
|
||||||
conditional-requires get
|
require-when-table [ V{ } clone ] initialize
|
||||||
[ dupd at members [ transfer-conditionals ] with each ]
|
|
||||||
[ delete-at ] 2bi ;
|
: 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 -- )
|
: load-source ( vocab -- )
|
||||||
dup check-vocab-hook get call( vocab -- )
|
dup check-vocab-hook get call( vocab -- )
|
||||||
|
@ -87,7 +88,7 @@ DEFER: require
|
||||||
[ +parsing+ >>source-loaded? ] dip
|
[ +parsing+ >>source-loaded? ] dip
|
||||||
[ % ] [ call( -- ) ] if-bootstrapping
|
[ % ] [ call( -- ) ] if-bootstrapping
|
||||||
+done+ >>source-loaded?
|
+done+ >>source-loaded?
|
||||||
vocab-name load-conditional-requires
|
load-conditional-requires
|
||||||
] [ ] [ f >>source-loaded? ] cleanup ;
|
] [ ] [ f >>source-loaded? ] cleanup ;
|
||||||
|
|
||||||
: load-docs ( vocab -- )
|
: load-docs ( vocab -- )
|
||||||
|
@ -104,22 +105,13 @@ PRIVATE>
|
||||||
: require ( vocab -- )
|
: require ( vocab -- )
|
||||||
load-vocab drop ;
|
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 -- )
|
: require-when ( if then -- )
|
||||||
swap [ vocab ] partition
|
over [ vocab ] all? [
|
||||||
[ drop require ] [ record-require-when ] if-empty ;
|
require drop
|
||||||
|
] [
|
||||||
|
[ drop [ require-when-vocabs get adjoin ] each ]
|
||||||
|
[ 2array require-when-table get push ] 2bi
|
||||||
|
] if ;
|
||||||
|
|
||||||
: reload ( name -- )
|
: reload ( name -- )
|
||||||
dup vocab
|
dup vocab
|
||||||
|
|
|
@ -83,25 +83,6 @@ ERROR: bad-vocab-name name ;
|
||||||
: check-vocab-name ( name -- name )
|
: check-vocab-name ( name -- name )
|
||||||
dup string? [ bad-vocab-name ] unless ;
|
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 )
|
: create-vocab ( name -- vocab )
|
||||||
check-vocab-name
|
check-vocab-name
|
||||||
dictionary get [ <vocab> ] cache
|
dictionary get [ <vocab> ] cache
|
||||||
|
@ -136,26 +117,9 @@ M: vocab-spec >vocab-link ;
|
||||||
|
|
||||||
M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
|
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 -- )
|
: forget-vocab ( vocab -- )
|
||||||
[ words forget-all ]
|
[ words forget-all ]
|
||||||
[ vocab-name dictionary get delete-at ]
|
[ vocab-name dictionary get delete-at ] bi
|
||||||
[ unload-conditional-requires ] tri
|
|
||||||
notify-vocab-observers ;
|
notify-vocab-observers ;
|
||||||
|
|
||||||
M: vocab-spec forget* forget-vocab ;
|
M: vocab-spec forget* forget-vocab ;
|
||||||
|
|
Loading…
Reference in New Issue