diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index b7366f154d..a4820f53cd 100644 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -284,6 +284,10 @@ HELP: auto-use? { $var-description "If set to a true value, the behavior of the parser when encountering an unknown word name is changed. If only one loaded vocabulary has a word with this name, instead of throwing an error, the parser adds the vocabulary to the search path and prints a parse note. Off by default." } { $notes "This feature is intended to help during development. To generate a " { $link POSTPONE: USING: } " form automatically, enable " { $link auto-use? } ", load the source file, and copy and paste the " { $link POSTPONE: USING: } " form printed by the parser back into the file, then disable " { $link auto-use? } ". See " { $link "word-search-errors" } "." } ; +HELP: use-first-word? +{ $values { "words" sequence } { "?" boolean } } +{ $description "Checks if the first word can be used automatically without first throwing a restartable " { $link no-word-error } } ; + HELP: scan-object { $values { "object" object } } { $description "Parses a literal representation of an object." } diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index d561d909e4..a8412da1b3 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -641,3 +641,9 @@ EXCLUDE: qualified.tests.bar => x ; [ "GENERIC: 33 ( -- )" "generic identifier test" parse-stream ] [ error>> lexer-error? ] must-fail-with + +{ t } [ + t auto-use? [ + { private? } use-first-word? + ] with-variable +] unit-test diff --git a/core/parser/parser.factor b/core/parser/parser.factor index eb2c332320..5793cbf4df 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -36,17 +36,17 @@ SYMBOL: auto-use? : private? ( word -- ? ) vocabulary>> ".private" tail? ; +: use-first-word? ( words -- ? ) + [ length 1 = ] [ ?first dup [ private? not ] [ ] ?if ] bi and + auto-use? get and ; + ! True branch is a singleton public word with no name conflicts ! False branch, singleton private words need confirmation regardless ! of name conflicts : no-word ( name -- newword ) dup words-named ignore-forwards - dup [ length 1 = ] - [ [ f ] [ first private? not ] if-empty ] bi and - auto-use? get and - [ nip first no-word-restarted ] - [ throw-restarts no-word-restarted ] - if ; + dup use-first-word? [ nip first ] [ throw-restarts ] if + no-word-restarted ; : parse-word ( string -- word ) dup search [ ] [ no-word ] ?if ;