ERROR: no-word-error name ;
: word-restarts ( possibilities -- restarts )
- natural-sort
- [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc ;
+ natural-sort [
+ [ vocabulary>> "Use the " " vocabulary" surround ] keep
+ ] { } map>assoc ;
: word-restarts-with-defer ( name possibilities -- restarts )
word-restarts
- swap "Defer word in current vocabulary" swap 2array
+ "Defer word in current vocabulary" rot 2array
suffix ;
: <no-word-error> ( name possibilities -- error restarts )
vocab-name manifest get search-vocab-names>> in? ;
: use-vocab ( vocab -- )
- dup using-vocab?
- [ vocab-name "Already using ``" "'' vocabulary" surround note. ] [
+ dup using-vocab? [
+ vocab-name "Already using ``" "'' vocabulary" surround note.
+ ] [
manifest get
- [ [ load-vocab ] dip search-vocabs>> push ]
+ [ [ ?load-vocab ] dip search-vocabs>> push ]
[ [ vocab-name ] dip search-vocab-names>> adjoin ]
2bi
] if ;
: use-words ( assoc -- )
<extra-words> qualified-vocabs push ;
-TUPLE: ambiguous-use-error words ;
+: unuse-words ( assoc -- )
+ <extra-words> qualified-vocabs remove! drop ;
+
+: with-words ( assoc quot -- )
+ '[ use-words @ ] over '[ _ unuse-words ] finally ; inline
-: <ambiguous-use-error> ( words -- error restarts )
+TUPLE: ambiguous-use-error name words ;
+
+: <ambiguous-use-error> ( name words -- error restarts )
[ ambiguous-use-error boa ] [ word-restarts ] bi ;
<PRIVATE
-: (vocab-search) ( name assocs -- words n )
- [ words>> (lookup) ] with map sift dup length ;
+: (lookup-word) ( words name vocab -- words )
+ words>> (lookup) [ suffix! ] when* ; inline
+
+: (vocab-search) ( name assocs -- words )
+ [ V{ } clone ] 2dip [ (lookup-word) ] with each ;
+
+: (vocab-search-qualified) ( words name assocs -- words )
+ [ ":" split1 swap ] dip pick [
+ [ name>> = ] with find nip [ (lookup-word) ] with when*
+ ] [
+ 3drop
+ ] if ;
+
+: (vocab-search-full) ( name assocs -- words )
+ [ (vocab-search) ] [ (vocab-search-qualified) ] 2bi ;
: vocab-search ( name manifest -- word/f )
- search-vocabs>>
- (vocab-search) {
- { 0 [ drop f ] }
- { 1 [ first ] }
+ dupd search-vocabs>> (vocab-search-full) dup length {
+ { 0 [ 2drop f ] }
+ { 1 [ first nip ] }
[
drop <ambiguous-use-error> throw-restarts
dup [ vocabulary>> ] [ name>> 1array ] bi add-words-from
} case ;
: qualified-search ( name manifest -- word/f )
- qualified-vocabs>>
- (vocab-search) 0 = [ drop f ] [ last ] if ;
+ qualified-vocabs>> (vocab-search) ?last ;
PRIVATE>
: search-manifest ( name manifest -- word/f )
- 2dup qualified-search dup [ 2nip ] [ drop vocab-search ] if ;
+ 2dup qualified-search [ 2nip ] [ vocab-search ] if* ;
: search ( name -- word/f )
manifest get search-manifest ;
[ call ] [
[ manifest get add-definition-observer call ]
[ manifest get remove-definition-observer ]
- [ ]
- cleanup
+ finally
] if-bootstrapping
] with-variable ; inline