steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

vocabs.parser: all USE: vocabs are also QUALIFIED:.

locals-and-roots
John Benediktsson 2016-03-29 09:59:58 -07:00
parent c5c7bb0e8d
commit b1be11f39c
2 changed files with 16 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/debugger/debugger.factor
View File

@ -310,8 +310,8 @@ M: no-word-in-vocab summary
M: no-word-in-vocab error. summary print ; M: no-word-in-vocab error. summary print ;
M: ambiguous-use-error summary M: ambiguous-use-error summary
words>> first name>> name>>
"More than one vocabulary defines a word named “" "”" surround ; "The name “" "” resolves to more than one word." surround ;
M: ambiguous-use-error error. summary print ; M: ambiguous-use-error error. summary print ;

23
core/vocabs/parser/parser.factor
View File

@ -175,20 +175,26 @@ TUPLE: rename word vocab words ;
: unuse-words ( assoc -- ) : unuse-words ( assoc -- )
<extra-words> qualified-vocabs remove! drop ; <extra-words> qualified-vocabs remove! drop ;
TUPLE: ambiguous-use-error words ; TUPLE: ambiguous-use-error name words ;
: <ambiguous-use-error> ( words -- error restarts ) : <ambiguous-use-error> ( name words -- error restarts )
[ ambiguous-use-error boa ] [ word-restarts ] bi ; [ ambiguous-use-error boa ] [ word-restarts ] bi ;
<PRIVATE <PRIVATE
: (vocab-search) ( name assocs -- words n ) : (vocab-search) ( name assocs -- words )
[ words>> (lookup) ] with map sift dup length ; [ words>> (lookup) ] with map sift ;
: (vocab-search-qualified) ( name assocs -- words )
[ ":" split1 swap ] dip [ name>> = ] with filter (vocab-search) ;
: (vocab-search-full) ( name assocs -- words )
[ (vocab-search-qualified) ] [ (vocab-search) ] 2bi append ;
: vocab-search ( name manifest -- word/f ) : vocab-search ( name manifest -- word/f )
search-vocabs>> (vocab-search) { dupd search-vocabs>> (vocab-search-full) dup length {
{ 0 [ drop f ] } { 0 [ 2drop f ] }
{ 1 [ first ] } { 1 [ first nip ] }
[ [
drop <ambiguous-use-error> throw-restarts drop <ambiguous-use-error> throw-restarts
dup [ vocabulary>> ] [ name>> 1array ] bi add-words-from dup [ vocabulary>> ] [ name>> 1array ] bi add-words-from
@ -196,8 +202,7 @@ TUPLE: ambiguous-use-error words ;
} case ; } case ;
: qualified-search ( name manifest -- word/f ) : qualified-search ( name manifest -- word/f )
qualified-vocabs>> qualified-vocabs>> (vocab-search) ?last ;
(vocab-search) 0 = [ drop f ] [ last ] if ;
PRIVATE> PRIVATE>