Rename use+ to add-use, move search to vocabs.parser, EXCLUDE: bombs out if word doesn't exist
parent
0378c612c6
commit
0c1e519dcb
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io kernel macros make multiline namespaces parser
|
||||
USING: io kernel macros make multiline namespaces vocabs.parser
|
||||
present sequences strings splitting fry accessors ;
|
||||
IN: interpolate
|
||||
|
||||
|
|
|
@ -12,7 +12,7 @@ IN: io.sockets
|
|||
<< {
|
||||
{ [ os windows? ] [ "windows.winsock" ] }
|
||||
{ [ os unix? ] [ "unix" ] }
|
||||
} cond use+ >>
|
||||
} cond add-use >>
|
||||
|
||||
! Addressing
|
||||
GENERIC: protocol-family ( addrspec -- af )
|
||||
|
|
|
@ -7,7 +7,7 @@ io.backend io.ports io.pathnames io.files.private
|
|||
io.encodings.utf8 math.parser continuations libc combinators
|
||||
system accessors destructors unix locals init ;
|
||||
|
||||
EXCLUDE: io => read write close ;
|
||||
EXCLUDE: io => read write ;
|
||||
EXCLUDE: io.sockets => accept ;
|
||||
|
||||
IN: io.sockets.unix
|
||||
|
|
|
@ -15,7 +15,7 @@ SYNTAX: hello "Hi" print ;
|
|||
] with-file-vocabs
|
||||
|
||||
[
|
||||
"debugger" use+
|
||||
"debugger" add-use
|
||||
|
||||
[ [ \ + 1 2 3 4 ] ]
|
||||
[
|
||||
|
|
|
@ -9,7 +9,7 @@ ERROR: unknown-gl-platform ;
|
|||
{ [ os macosx? ] [ "opengl.gl.macosx" ] }
|
||||
{ [ os unix? ] [ "opengl.gl.unix" ] }
|
||||
[ unknown-gl-platform ]
|
||||
} cond use+ >>
|
||||
} cond add-use >>
|
||||
|
||||
SYMBOL: +gl-function-number-counter+
|
||||
SYMBOL: +gl-function-pointers+
|
||||
|
|
|
@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
|
|||
continuations peg peg.parsers unicode.categories multiline
|
||||
splitting accessors effects sequences.deep peg.search
|
||||
combinators.short-circuit lexer io.streams.string stack-checker
|
||||
io combinators parser summary ;
|
||||
io combinators parser vocabs.parser summary ;
|
||||
IN: peg.ebnf
|
||||
|
||||
: rule ( name word -- parser )
|
||||
|
|
|
@ -25,7 +25,7 @@ HELP: see-methods
|
|||
{ $contract "Prettyprints the methods defined on a generic word or class." } ;
|
||||
|
||||
HELP: definer
|
||||
{ $values { "defspec" "a definition specifier" } { "start" word } { "end" "a word or " { $link f } } }
|
||||
{ $values { "defspec" "a definition specifier" } { "start" word } { "end" { $maybe word } } }
|
||||
{ $contract "Outputs the parsing words which delimit the definition." }
|
||||
{ $examples
|
||||
{ $example "USING: definitions prettyprint ;"
|
||||
|
|
|
@ -2,11 +2,11 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs combinators compiler.units
|
||||
continuations debugger effects fry generalizations io io.files
|
||||
io.styles kernel lexer locals macros math.parser namespaces
|
||||
parser prettyprint quotations sequences source-files splitting
|
||||
io.styles kernel lexer locals macros math.parser namespaces parser
|
||||
vocabs.parser prettyprint quotations sequences source-files splitting
|
||||
stack-checker summary unicode.case vectors vocabs vocabs.loader
|
||||
vocabs.files words tools.errors source-files.errors
|
||||
io.streams.string make compiler.errors ;
|
||||
vocabs.files words tools.errors source-files.errors io.streams.string
|
||||
make compiler.errors ;
|
||||
IN: tools.test
|
||||
|
||||
TUPLE: test-failure < source-file-error continuation ;
|
||||
|
|
|
@ -6,7 +6,7 @@ IN: ui.pixel-formats
|
|||
<<
|
||||
"ui.gadgets.worlds" create-vocab drop
|
||||
"world" "ui.gadgets.worlds" create drop
|
||||
"ui.gadgets.worlds" (use+)
|
||||
"ui.gadgets.worlds" (add-use)
|
||||
>>
|
||||
|
||||
ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"
|
||||
|
|
|
@ -137,7 +137,7 @@ M: word com-stack-effect 1quotation com-stack-effect ;
|
|||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
: com-use-vocab ( vocab -- ) vocab-name use+ ;
|
||||
: com-use-vocab ( vocab -- ) vocab-name add-use ;
|
||||
|
||||
[ vocab-spec? ] \ com-use-vocab H{
|
||||
{ +secondary+ t }
|
||||
|
|
|
@ -119,45 +119,7 @@ HELP: parser-notes?
|
|||
HELP: bad-number
|
||||
{ $error-description "Indicates the parser encountered an invalid numeric literal." } ;
|
||||
|
||||
HELP: use
|
||||
{ $var-description "A variable holding the current vocabulary search path as a sequence of assocs." } ;
|
||||
|
||||
{ use in use+ (use+) set-use set-in POSTPONE: USING: POSTPONE: USE: with-file-vocabs with-interactive-vocabs } related-words
|
||||
|
||||
HELP: in
|
||||
{ $var-description "A variable holding the name of the current vocabulary for new definitions." } ;
|
||||
|
||||
HELP: current-vocab
|
||||
{ $values { "str" "a vocabulary" } }
|
||||
{ $description "Returns the vocabulary stored in the " { $link in } " symbol. Throws an error if the current vocabulary is " { $link f } "." } ;
|
||||
|
||||
HELP: (use+)
|
||||
{ $values { "vocab" "an assoc mapping strings to words" } }
|
||||
{ $description "Adds an assoc at the front of the search path." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: use+
|
||||
{ $values { "vocab" string } }
|
||||
{ $description "Adds a new vocabulary at the front of the search path after loading it if necessary. Subsequent word lookups by the parser will search this vocabulary first." }
|
||||
$parsing-note
|
||||
{ $errors "Throws an error if the vocabulary does not exist." } ;
|
||||
|
||||
HELP: set-use
|
||||
{ $values { "seq" "a sequence of strings" } }
|
||||
{ $description "Sets the vocabulary search path. Later vocabularies take precedence." }
|
||||
{ $errors "Throws an error if one of the vocabularies does not exist." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: add-use
|
||||
{ $values { "seq" "a sequence of strings" } }
|
||||
{ $description "Adds multiple vocabularies to the search path, with later vocabularies taking precedence." }
|
||||
{ $errors "Throws an error if one of the vocabularies does not exist." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: set-in
|
||||
{ $values { "name" string } }
|
||||
{ $description "Sets the current vocabulary where new words will be defined, creating the vocabulary first if it does not exist." }
|
||||
$parsing-note ;
|
||||
{ use in add-use (add-use) set-use set-in POSTPONE: USING: POSTPONE: USE: with-file-vocabs with-interactive-vocabs } related-words
|
||||
|
||||
HELP: create-in
|
||||
{ $values { "str" "a word name" } { "word" "a new word" } }
|
||||
|
@ -178,11 +140,6 @@ HELP: no-word
|
|||
{ $values { "name" string } { "newword" word } }
|
||||
{ $description "Throws a " { $link no-word-error } "." } ;
|
||||
|
||||
HELP: search
|
||||
{ $values { "str" string } { "word/f" "a word or " { $link f } } }
|
||||
{ $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, outputs " { $link f } "." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: scan-word
|
||||
{ $values { "word/number/f" "a word, number or " { $link f } } }
|
||||
{ $description "Reads the next token from parser input. If the token is a valid number literal, it is converted to a number, otherwise the dictionary is searched for a word named by the token. Outputs " { $link f } " if the end of the input has been reached." }
|
||||
|
|
|
@ -4,7 +4,7 @@ sequences strings io.files io.pathnames definitions
|
|||
continuations sorting classes.tuple compiler.units debugger
|
||||
vocabs vocabs.loader accessors eval combinators lexer
|
||||
vocabs.parser words.symbol multiline source-files.errors
|
||||
tools.crossref ;
|
||||
tools.crossref grouping ;
|
||||
IN: parser.tests
|
||||
|
||||
[
|
||||
|
@ -583,3 +583,41 @@ EXCLUDE: qualified.tests.bar => x ;
|
|||
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup >boolean ] unit-test
|
||||
[ t ] [ "is-not-deferred" "parser.tests" lookup deferred? ] unit-test
|
||||
|
||||
! Forward-reference resolution case iterated using list in the wrong direction
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests.forward-ref-1 DEFER: x DEFER: y"
|
||||
<string-reader> "forward-ref-1" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests.forward-ref-2 DEFER: x DEFER: y"
|
||||
<string-reader> "forward-ref-2" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests.forward-ref-3 USING: parser.tests.forward-ref-1 parser.tests.forward-ref-2 ; : z ( -- ) x y ;"
|
||||
<string-reader> "forward-ref-3" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"USING: parser.tests.forward-ref-1 parser.tests.forward-ref-2 ; IN: parser.tests.forward-ref-3 : x ( -- ) ; : z ( -- ) x y ;"
|
||||
<string-reader> "forward-ref-3" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
||||
|
||||
[ [ ] ] [
|
||||
"IN: parser.tests.forward-ref-3 USING: parser.tests.forward-ref-1 parser.tests.forward-ref-2 ; : z ( -- ) x y ;"
|
||||
<string-reader> "forward-ref-3" parse-stream
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||
] unit-test
|
|
@ -55,7 +55,7 @@ SYMBOL: auto-use?
|
|||
: no-word-restarted ( restart-value -- word )
|
||||
dup word? [
|
||||
dup vocabulary>>
|
||||
[ (use+) ]
|
||||
[ (add-use) ]
|
||||
[ amended-use get dup [ push ] [ 2drop ] if ]
|
||||
[ "Added \"" "\" vocabulary to search path" surround note. ]
|
||||
tri
|
||||
|
@ -68,19 +68,6 @@ SYMBOL: auto-use?
|
|||
[ <no-word-error> throw-restarts no-word-restarted ]
|
||||
if ;
|
||||
|
||||
: check-forward ( str word -- word/f )
|
||||
dup forward-reference? [
|
||||
drop
|
||||
use get
|
||||
[ at ] with map sift
|
||||
[ forward-reference? not ] find nip
|
||||
] [
|
||||
nip
|
||||
] if ;
|
||||
|
||||
: search ( str -- word/f )
|
||||
dup use get assoc-stack check-forward ;
|
||||
|
||||
: scan-word ( -- word/number/f )
|
||||
scan dup [
|
||||
dup search [ ] [
|
||||
|
|
|
@ -49,9 +49,9 @@ IN: bootstrap.syntax
|
|||
POSTPONE: PRIVATE> in get ".private" append set-in
|
||||
] define-core-syntax
|
||||
|
||||
"USE:" [ scan use+ ] define-core-syntax
|
||||
"USE:" [ scan add-use ] define-core-syntax
|
||||
|
||||
"USING:" [ ";" parse-tokens add-use ] define-core-syntax
|
||||
"USING:" [ ";" parse-tokens [ add-use ] each ] define-core-syntax
|
||||
|
||||
"QUALIFIED:" [ scan dup add-qualified ] define-core-syntax
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
USING: help.markup help.syntax parser ;
|
||||
USING: help.markup help.syntax parser strings words ;
|
||||
IN: vocabs.parser
|
||||
|
||||
ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
|
||||
|
@ -78,3 +78,40 @@ $nl
|
|||
{ $see-also "words" } ;
|
||||
|
||||
ABOUT: "vocabulary-search"
|
||||
|
||||
HELP: use
|
||||
{ $var-description "A variable holding the current vocabulary search path as a sequence of assocs." } ;
|
||||
|
||||
HELP: in
|
||||
{ $var-description "A variable holding the name of the current vocabulary for new definitions." } ;
|
||||
|
||||
HELP: current-vocab
|
||||
{ $values { "str" "a vocabulary" } }
|
||||
{ $description "Returns the vocabulary stored in the " { $link in } " symbol. Throws an error if the current vocabulary is " { $link f } "." } ;
|
||||
|
||||
HELP: (add-use)
|
||||
{ $values { "vocab" "an assoc mapping strings to words" } }
|
||||
{ $description "Adds an assoc at the front of the search path." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: add-use
|
||||
{ $values { "vocab" string } }
|
||||
{ $description "Adds a new vocabulary at the front of the search path after loading it if necessary. Subsequent word lookups by the parser will search this vocabulary first." }
|
||||
$parsing-note
|
||||
{ $errors "Throws an error if the vocabulary does not exist." } ;
|
||||
|
||||
HELP: set-use
|
||||
{ $values { "seq" "a sequence of strings" } }
|
||||
{ $description "Sets the vocabulary search path. Later vocabularies take precedence." }
|
||||
{ $errors "Throws an error if one of the vocabularies does not exist." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: set-in
|
||||
{ $values { "name" string } }
|
||||
{ $description "Sets the current vocabulary where new words will be defined, creating the vocabulary first if it does not exist." }
|
||||
$parsing-note ;
|
||||
|
||||
HELP: search
|
||||
{ $values { "str" string } { "word/f" { $maybe word } } }
|
||||
{ $description "Searches for a word by name in the current vocabulary search path. If no such word could be found, outputs " { $link f } "." }
|
||||
$parsing-note ;
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
! Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs hashtables kernel namespaces sequences
|
||||
sets strings vocabs sorting accessors arrays ;
|
||||
sets strings vocabs sorting accessors arrays compiler.units ;
|
||||
IN: vocabs.parser
|
||||
|
||||
ERROR: no-word-error name ;
|
||||
|
@ -19,13 +19,11 @@ ERROR: no-word-error name ;
|
|||
SYMBOL: use
|
||||
SYMBOL: in
|
||||
|
||||
: (use+) ( vocab -- )
|
||||
: (add-use) ( vocab -- )
|
||||
vocab-words use get push ;
|
||||
|
||||
: use+ ( vocab -- )
|
||||
load-vocab (use+) ;
|
||||
|
||||
: add-use ( seq -- ) [ use+ ] each ;
|
||||
: add-use ( vocab -- )
|
||||
load-vocab (add-use) ;
|
||||
|
||||
: set-use ( seq -- )
|
||||
[ vocab-words ] V{ } map-as sift use set ;
|
||||
|
@ -35,15 +33,17 @@ SYMBOL: in
|
|||
[ swap [ prepend ] dip ] curry assoc-map
|
||||
use get push ;
|
||||
|
||||
: partial-vocab ( words vocab -- assoc )
|
||||
load-vocab vocab-words
|
||||
: words-named-in ( words assoc -- assoc' )
|
||||
[ dupd at [ no-word-error ] unless* ] curry { } map>assoc ;
|
||||
|
||||
: partial-vocab-including ( words vocab -- assoc )
|
||||
load-vocab vocab-words words-named-in ;
|
||||
|
||||
: add-words-from ( words vocab -- )
|
||||
partial-vocab use get push ;
|
||||
partial-vocab-including use get push ;
|
||||
|
||||
: partial-vocab-excluding ( words vocab -- assoc )
|
||||
load-vocab [ vocab-words keys swap diff ] keep partial-vocab ;
|
||||
load-vocab vocab-words [ nip ] [ words-named-in ] 2bi assoc-diff ;
|
||||
|
||||
: add-words-excluding ( words vocab -- )
|
||||
partial-vocab-excluding use get push ;
|
||||
|
@ -56,4 +56,17 @@ SYMBOL: in
|
|||
dup string? [ "Vocabulary name must be a string" throw ] unless ;
|
||||
|
||||
: set-in ( name -- )
|
||||
check-vocab-string dup in set create-vocab (use+) ;
|
||||
check-vocab-string dup in set create-vocab (add-use) ;
|
||||
|
||||
: check-forward ( str word -- word/f )
|
||||
dup forward-reference? [
|
||||
drop
|
||||
use get
|
||||
[ at ] with map sift
|
||||
[ forward-reference? not ] find-last nip
|
||||
] [
|
||||
nip
|
||||
] if ;
|
||||
|
||||
: search ( str -- word/f )
|
||||
dup use get assoc-stack check-forward ;
|
|
@ -237,7 +237,7 @@ HELP: set-word
|
|||
{ $description "Sets the recently defined word." } ;
|
||||
|
||||
HELP: lookup
|
||||
{ $values { "name" string } { "vocab" string } { "word" "a word or " { $link f } } }
|
||||
{ $values { "name" string } { "vocab" string } { "word" { $maybe word } } }
|
||||
{ $description "Looks up a word in the dictionary. If the vocabulary or the word is not defined, outputs " { $link f } "." } ;
|
||||
|
||||
HELP: reveal
|
||||
|
|
|
@ -60,7 +60,7 @@ t fuel-eval-res-flag set-global
|
|||
[ print-error ] recover ;
|
||||
|
||||
: (fuel-eval-usings) ( usings -- )
|
||||
[ [ use+ ] curry [ drop ] recover ] each
|
||||
[ [ add-use ] curry [ drop ] recover ] each
|
||||
fuel-forget-error fuel-forget-output ;
|
||||
|
||||
: (fuel-eval-in) ( in -- )
|
||||
|
|
|
@ -9,7 +9,7 @@ IN: sandbox.syntax
|
|||
ERROR: sandbox-error vocab ;
|
||||
|
||||
: sandbox-use+ ( alias -- )
|
||||
dup whitelist get at [ use+ ] [ sandbox-error ] ?if ;
|
||||
dup whitelist get at [ add-use ] [ sandbox-error ] ?if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
Loading…
Reference in New Issue