FROM: and RENAME: give a more meaningful error if the vocabulary does not exist
parent
64f7a290f5
commit
a222fc6bd2
|
@ -258,6 +258,12 @@ M: no-word-error summary
|
||||||
|
|
||||||
M: no-word-error error. summary print ;
|
M: no-word-error error. summary print ;
|
||||||
|
|
||||||
|
M: no-word-in-vocab summary
|
||||||
|
[ vocab>> ] [ word>> ] bi
|
||||||
|
[ "No word named ``" % % "'' found in ``" % % "'' vocabulary" % ] "" make ;
|
||||||
|
|
||||||
|
M: no-word-in-vocab error. summary print ;
|
||||||
|
|
||||||
M: ambiguous-use-error summary
|
M: ambiguous-use-error summary
|
||||||
words>> first name>>
|
words>> first name>>
|
||||||
"More than one vocabulary defines a word named ``" "''" surround ;
|
"More than one vocabulary defines a word named ``" "''" surround ;
|
||||||
|
|
|
@ -59,16 +59,19 @@ C: <extra-words> extra-words
|
||||||
[ qualified-vocabs>> delete-all ]
|
[ qualified-vocabs>> delete-all ]
|
||||||
tri ;
|
tri ;
|
||||||
|
|
||||||
|
ERROR: no-word-in-vocab word vocab ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (add-qualified) ( qualified -- )
|
: (add-qualified) ( qualified -- )
|
||||||
manifest get qualified-vocabs>> push ;
|
manifest get qualified-vocabs>> push ;
|
||||||
|
|
||||||
: (from) ( vocab words -- vocab words words' assoc )
|
: (from) ( vocab words -- vocab words words' vocab )
|
||||||
2dup swap load-vocab words>> ;
|
2dup swap load-vocab ;
|
||||||
|
|
||||||
: extract-words ( seq assoc -- assoc' )
|
: extract-words ( seq vocab -- assoc' )
|
||||||
extract-keys dup [ [ drop ] [ no-word-error ] if ] assoc-each ;
|
[ words>> extract-keys dup ] [ name>> ] bi
|
||||||
|
[ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;
|
||||||
|
|
||||||
: (lookup) ( name assoc -- word/f )
|
: (lookup) ( name assoc -- word/f )
|
||||||
at dup forward-reference? [ drop f ] when ;
|
at dup forward-reference? [ drop f ] when ;
|
||||||
|
@ -148,7 +151,7 @@ TUPLE: from vocab names words ;
|
||||||
TUPLE: exclude vocab names words ;
|
TUPLE: exclude vocab names words ;
|
||||||
|
|
||||||
: <exclude> ( vocab words -- from )
|
: <exclude> ( vocab words -- from )
|
||||||
(from) [ nip ] [ extract-words ] 2bi assoc-diff exclude boa ;
|
(from) [ nip words>> ] [ extract-words ] 2bi assoc-diff exclude boa ;
|
||||||
|
|
||||||
: add-words-excluding ( vocab words -- )
|
: add-words-excluding ( vocab words -- )
|
||||||
<exclude> (add-qualified) ;
|
<exclude> (add-qualified) ;
|
||||||
|
@ -156,7 +159,7 @@ TUPLE: exclude vocab names words ;
|
||||||
TUPLE: rename word vocab words ;
|
TUPLE: rename word vocab words ;
|
||||||
|
|
||||||
: <rename> ( word vocab new-name -- rename )
|
: <rename> ( word vocab new-name -- rename )
|
||||||
[ 2dup load-vocab words>> dupd at [ ] [ no-word-error ] ?if ] dip
|
[ 2dup load-vocab words>> dupd at [ ] [ swap no-word-in-vocab ] ?if ] dip
|
||||||
associate rename boa ;
|
associate rename boa ;
|
||||||
|
|
||||||
: add-renamed-word ( word vocab new-name -- )
|
: add-renamed-word ( word vocab new-name -- )
|
||||||
|
|
Loading…
Reference in New Issue