Rename use+ to add-use, move search to vocabs.parser, EXCLUDE: bombs out if word doesn't exist

db4
Slava Pestov 2009-05-13 22:15:48 -05:00
parent 0378c612c6
commit 0c1e519dcb
19 changed files with 121 additions and 89 deletions

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! 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 ; present sequences strings splitting fry accessors ;
IN: interpolate IN: interpolate

View File

@ -12,7 +12,7 @@ IN: io.sockets
<< { << {
{ [ os windows? ] [ "windows.winsock" ] } { [ os windows? ] [ "windows.winsock" ] }
{ [ os unix? ] [ "unix" ] } { [ os unix? ] [ "unix" ] }
} cond use+ >> } cond add-use >>
! Addressing ! Addressing
GENERIC: protocol-family ( addrspec -- af ) GENERIC: protocol-family ( addrspec -- af )

View File

@ -7,7 +7,7 @@ io.backend io.ports io.pathnames io.files.private
io.encodings.utf8 math.parser continuations libc combinators io.encodings.utf8 math.parser continuations libc combinators
system accessors destructors unix locals init ; system accessors destructors unix locals init ;
EXCLUDE: io => read write close ; EXCLUDE: io => read write ;
EXCLUDE: io.sockets => accept ; EXCLUDE: io.sockets => accept ;
IN: io.sockets.unix IN: io.sockets.unix

View File

@ -15,7 +15,7 @@ SYNTAX: hello "Hi" print ;
] with-file-vocabs ] with-file-vocabs
[ [
"debugger" use+ "debugger" add-use
[ [ \ + 1 2 3 4 ] ] [ [ \ + 1 2 3 4 ] ]
[ [

View File

@ -9,7 +9,7 @@ ERROR: unknown-gl-platform ;
{ [ os macosx? ] [ "opengl.gl.macosx" ] } { [ os macosx? ] [ "opengl.gl.macosx" ] }
{ [ os unix? ] [ "opengl.gl.unix" ] } { [ os unix? ] [ "opengl.gl.unix" ] }
[ unknown-gl-platform ] [ unknown-gl-platform ]
} cond use+ >> } cond add-use >>
SYMBOL: +gl-function-number-counter+ SYMBOL: +gl-function-number-counter+
SYMBOL: +gl-function-pointers+ SYMBOL: +gl-function-pointers+

View File

@ -5,7 +5,7 @@ sequences quotations vectors namespaces make math assocs
continuations peg peg.parsers unicode.categories multiline continuations peg peg.parsers unicode.categories multiline
splitting accessors effects sequences.deep peg.search splitting accessors effects sequences.deep peg.search
combinators.short-circuit lexer io.streams.string stack-checker combinators.short-circuit lexer io.streams.string stack-checker
io combinators parser summary ; io combinators parser vocabs.parser summary ;
IN: peg.ebnf IN: peg.ebnf
: rule ( name word -- parser ) : rule ( name word -- parser )

View File

@ -25,7 +25,7 @@ HELP: see-methods
{ $contract "Prettyprints the methods defined on a generic word or class." } ; { $contract "Prettyprints the methods defined on a generic word or class." } ;
HELP: definer 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." } { $contract "Outputs the parsing words which delimit the definition." }
{ $examples { $examples
{ $example "USING: definitions prettyprint ;" { $example "USING: definitions prettyprint ;"

View File

@ -2,11 +2,11 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.units USING: accessors arrays assocs combinators compiler.units
continuations debugger effects fry generalizations io io.files continuations debugger effects fry generalizations io io.files
io.styles kernel lexer locals macros math.parser namespaces io.styles kernel lexer locals macros math.parser namespaces parser
parser prettyprint quotations sequences source-files splitting vocabs.parser prettyprint quotations sequences source-files splitting
stack-checker summary unicode.case vectors vocabs vocabs.loader stack-checker summary unicode.case vectors vocabs vocabs.loader
vocabs.files words tools.errors source-files.errors vocabs.files words tools.errors source-files.errors io.streams.string
io.streams.string make compiler.errors ; make compiler.errors ;
IN: tools.test IN: tools.test
TUPLE: test-failure < source-file-error continuation ; TUPLE: test-failure < source-file-error continuation ;

View File

@ -6,7 +6,7 @@ IN: ui.pixel-formats
<< <<
"ui.gadgets.worlds" create-vocab drop "ui.gadgets.worlds" create-vocab drop
"world" "ui.gadgets.worlds" create drop "world" "ui.gadgets.worlds" create drop
"ui.gadgets.worlds" (use+) "ui.gadgets.worlds" (add-use)
>> >>
ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes" ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"

View File

@ -137,7 +137,7 @@ M: word com-stack-effect 1quotation com-stack-effect ;
{ +listener+ t } { +listener+ t }
} define-operation } define-operation
: com-use-vocab ( vocab -- ) vocab-name use+ ; : com-use-vocab ( vocab -- ) vocab-name add-use ;
[ vocab-spec? ] \ com-use-vocab H{ [ vocab-spec? ] \ com-use-vocab H{
{ +secondary+ t } { +secondary+ t }

View File

@ -119,45 +119,7 @@ HELP: parser-notes?
HELP: bad-number HELP: bad-number
{ $error-description "Indicates the parser encountered an invalid numeric literal." } ; { $error-description "Indicates the parser encountered an invalid numeric literal." } ;
HELP: use { use in add-use (add-use) set-use set-in POSTPONE: USING: POSTPONE: USE: with-file-vocabs with-interactive-vocabs } related-words
{ $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 ;
HELP: create-in HELP: create-in
{ $values { "str" "a word name" } { "word" "a new word" } } { $values { "str" "a word name" } { "word" "a new word" } }
@ -178,11 +140,6 @@ HELP: no-word
{ $values { "name" string } { "newword" word } } { $values { "name" string } { "newword" word } }
{ $description "Throws a " { $link no-word-error } "." } ; { $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 HELP: scan-word
{ $values { "word/number/f" "a word, number or " { $link f } } } { $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." } { $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." }

View File

@ -4,7 +4,7 @@ sequences strings io.files io.pathnames definitions
continuations sorting classes.tuple compiler.units debugger continuations sorting classes.tuple compiler.units debugger
vocabs vocabs.loader accessors eval combinators lexer vocabs vocabs.loader accessors eval combinators lexer
vocabs.parser words.symbol multiline source-files.errors vocabs.parser words.symbol multiline source-files.errors
tools.crossref ; tools.crossref grouping ;
IN: parser.tests 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 >boolean ] unit-test
[ t ] [ "is-not-deferred" "parser.tests" lookup deferred? ] 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

View File

@ -55,7 +55,7 @@ SYMBOL: auto-use?
: no-word-restarted ( restart-value -- word ) : no-word-restarted ( restart-value -- word )
dup word? [ dup word? [
dup vocabulary>> dup vocabulary>>
[ (use+) ] [ (add-use) ]
[ amended-use get dup [ push ] [ 2drop ] if ] [ amended-use get dup [ push ] [ 2drop ] if ]
[ "Added \"" "\" vocabulary to search path" surround note. ] [ "Added \"" "\" vocabulary to search path" surround note. ]
tri tri
@ -68,19 +68,6 @@ SYMBOL: auto-use?
[ <no-word-error> throw-restarts no-word-restarted ] [ <no-word-error> throw-restarts no-word-restarted ]
if ; 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-word ( -- word/number/f )
scan dup [ scan dup [
dup search [ ] [ dup search [ ] [

View File

@ -49,9 +49,9 @@ IN: bootstrap.syntax
POSTPONE: PRIVATE> in get ".private" append set-in POSTPONE: PRIVATE> in get ".private" append set-in
] define-core-syntax ] 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 "QUALIFIED:" [ scan dup add-qualified ] define-core-syntax

View File

@ -1,4 +1,4 @@
USING: help.markup help.syntax parser ; USING: help.markup help.syntax parser strings words ;
IN: vocabs.parser IN: vocabs.parser
ARTICLE: "vocabulary-search-shadow" "Shadowing word names" ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
@ -78,3 +78,40 @@ $nl
{ $see-also "words" } ; { $see-also "words" } ;
ABOUT: "vocabulary-search" 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 ;

View File

@ -2,7 +2,7 @@
! Slava Pestov. ! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs hashtables kernel namespaces sequences USING: assocs hashtables kernel namespaces sequences
sets strings vocabs sorting accessors arrays ; sets strings vocabs sorting accessors arrays compiler.units ;
IN: vocabs.parser IN: vocabs.parser
ERROR: no-word-error name ; ERROR: no-word-error name ;
@ -19,13 +19,11 @@ ERROR: no-word-error name ;
SYMBOL: use SYMBOL: use
SYMBOL: in SYMBOL: in
: (use+) ( vocab -- ) : (add-use) ( vocab -- )
vocab-words use get push ; vocab-words use get push ;
: use+ ( vocab -- ) : add-use ( vocab -- )
load-vocab (use+) ; load-vocab (add-use) ;
: add-use ( seq -- ) [ use+ ] each ;
: set-use ( seq -- ) : set-use ( seq -- )
[ vocab-words ] V{ } map-as sift use set ; [ vocab-words ] V{ } map-as sift use set ;
@ -35,15 +33,17 @@ SYMBOL: in
[ swap [ prepend ] dip ] curry assoc-map [ swap [ prepend ] dip ] curry assoc-map
use get push ; use get push ;
: partial-vocab ( words vocab -- assoc ) : words-named-in ( words assoc -- assoc' )
load-vocab vocab-words
[ dupd at [ no-word-error ] unless* ] curry { } map>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 -- ) : add-words-from ( words vocab -- )
partial-vocab use get push ; partial-vocab-including use get push ;
: partial-vocab-excluding ( words vocab -- assoc ) : 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 -- ) : add-words-excluding ( words vocab -- )
partial-vocab-excluding use get push ; partial-vocab-excluding use get push ;
@ -56,4 +56,17 @@ SYMBOL: in
dup string? [ "Vocabulary name must be a string" throw ] unless ; dup string? [ "Vocabulary name must be a string" throw ] unless ;
: set-in ( name -- ) : 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 ;

View File

@ -237,7 +237,7 @@ HELP: set-word
{ $description "Sets the recently defined word." } ; { $description "Sets the recently defined word." } ;
HELP: lookup 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 } "." } ; { $description "Looks up a word in the dictionary. If the vocabulary or the word is not defined, outputs " { $link f } "." } ;
HELP: reveal HELP: reveal

View File

@ -60,7 +60,7 @@ t fuel-eval-res-flag set-global
[ print-error ] recover ; [ print-error ] recover ;
: (fuel-eval-usings) ( usings -- ) : (fuel-eval-usings) ( usings -- )
[ [ use+ ] curry [ drop ] recover ] each [ [ add-use ] curry [ drop ] recover ] each
fuel-forget-error fuel-forget-output ; fuel-forget-error fuel-forget-output ;
: (fuel-eval-in) ( in -- ) : (fuel-eval-in) ( in -- )

View File

@ -9,7 +9,7 @@ IN: sandbox.syntax
ERROR: sandbox-error vocab ; ERROR: sandbox-error vocab ;
: sandbox-use+ ( alias -- ) : sandbox-use+ ( alias -- )
dup whitelist get at [ use+ ] [ sandbox-error ] ?if ; dup whitelist get at [ add-use ] [ sandbox-error ] ?if ;
PRIVATE> PRIVATE>