diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index bb0268f048..7994c3ed96 100644 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -251,8 +251,15 @@ M: already-disposed summary drop "Attempting to operate on disposed object" ; M: no-current-vocab summary drop "Not in a vocabulary; IN: form required" ; -M: no-word-error error. - "No word named ``" write name>> write "'' found in current vocabulary search path" print ; +M: no-word-error summary + name>> "No word named ``" "'' found in current vocabulary search path" surround ; + +M: no-word-error error. summary print ; + +M: ambiguous-use-error summary + words>> first name>> "More than one vocabulary defines a word named ``" "''" surround ; + +M: ambiguous-use-error error. summary print ; M: staging-violation summary drop diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 2e89482c3d..e12e59d259 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -55,7 +55,9 @@ M: vocab-completion (word-at-caret) drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ; M: word-completion (word-at-caret) - manifest>> dup [ search-manifest ] [ 2drop f ] if ; + manifest>> dup [ + '[ _ _ search-manifest ] [ drop f ] recover + ] [ 2drop f ] if ; M: char-completion (word-at-caret) 2drop f ; diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index 16f08d474a..5cbcc14184 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -608,4 +608,16 @@ EXCLUDE: qualified.tests.bar => x ; [ t ] [ "z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal? -] unit-test \ No newline at end of file +] unit-test + +[ [ dup ] ] [ + "USE: kernel dup" "unuse-test" parse-stream +] unit-test + +[ + "dup" "unuse-test" parse-stream +] [ error>> error>> error>> no-word-error? ] must-fail-with + +[ + "USE: kernel UNUSE: kernel dup" "unuse-test" parse-stream +] [ error>> error>> error>> no-word-error? ] must-fail-with \ No newline at end of file diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 43451b4c86..ba4fb265c3 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -8,8 +8,21 @@ IN: vocabs.parser ERROR: no-word-error name ; +: word-restarts ( possibilities -- restarts ) + 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 + suffix ; + +: ( name possibilities -- error restarts ) + [ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ; + TUPLE: manifest current-vocab +{ search-vocab-names hashtable } { search-vocabs vector } { qualified-vocabs vector } { extra-words vector } @@ -17,6 +30,7 @@ current-vocab : ( -- manifest ) manifest new + H{ } clone >>search-vocab-names V{ } clone >>search-vocabs V{ } clone >>qualified-vocabs V{ } clone >>extra-words @@ -24,6 +38,7 @@ current-vocab M: manifest clone call-next-method + [ clone ] change-search-vocab-names [ clone ] change-search-vocabs [ clone ] change-qualified-vocabs [ clone ] change-extra-words @@ -40,12 +55,10 @@ C: extra-words : clear-manifest ( -- ) manifest get + [ search-vocab-names>> clear-assoc ] [ search-vocabs>> delete-all ] [ qualified-vocabs>> delete-all ] - bi ; - -: (use-vocab) ( vocab -- vocab seq ) - load-vocab manifest get search-vocabs>> ; + tri ; : (add-qualified) ( qualified -- ) manifest get qualified-vocabs>> push ; @@ -87,19 +100,33 @@ TUPLE: no-current-vocab ; manifest get current-vocab>> vocab-name ".private" ?tail [ set-current-vocab ] [ drop ] if ; -: use-vocab ( vocab -- ) (use-vocab) push ; +: using-vocab? ( vocab -- ? ) + vocab-name manifest get search-vocab-names>> key? ; + +: use-vocab ( vocab -- ) + dup using-vocab? + [ drop ] [ + manifest get + [ [ vocab-name ] dip search-vocab-names>> conjoin ] + [ [ load-vocab ] dip search-vocabs>> push ] + 2bi + ] if ; : auto-use-vocab ( vocab -- ) [ use-vocab ] [ manifest get auto-used>> push ] bi ; : auto-used? ( -- ? ) manifest get auto-used>> length 0 > ; -: unuse-vocab ( vocab -- ) (use-vocab) delq ; +: unuse-vocab ( vocab -- ) + dup using-vocab? [ + manifest get + [ [ vocab-name ] dip search-vocab-names>> delete-at ] + [ [ load-vocab ] dip search-vocabs>> delq ] + 2bi + ] [ drop ] if ; : only-use-vocabs ( vocabs -- ) - clear-manifest - [ vocab ] V{ } map-as sift - manifest get search-vocabs>> push-all ; + clear-manifest [ vocab ] filter [ use-vocab ] each ; TUPLE: qualified vocab prefix words ; @@ -141,7 +168,10 @@ TUPLE: rename word vocab words ; : unuse-words ( assoc -- ) (use-words) delete ; -ERROR: ambiguous-use-error words ; +TUPLE: ambiguous-use-error words ; + +: ( words -- error restarts ) + [ \ ambiguous-use-error boa ] [ word-restarts ] bi ; throw-restarts + dup [ vocabulary>> ] [ name>> 1array ] bi add-words-from + ] } case ; : qualified-search ( name manifest -- word/f ) @@ -168,12 +201,3 @@ PRIVATE> : search ( name -- word/f ) manifest get search-manifest ; - -: word-restarts ( name possibilities -- restarts ) - natural-sort - [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc - swap "Defer word in current vocabulary" swap 2array - suffix ; - -: ( name possibilities -- error restarts ) - [ drop \ no-word-error boa ] [ word-restarts ] 2bi ;