! 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
<< {
{ [ os windows? ] [ "windows.winsock" ] }
{ [ os unix? ] [ "unix" ] }
-} cond use+ >>
+} cond add-use >>
! Addressing
GENERIC: protocol-family ( addrspec -- af )
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
] with-file-vocabs
[
- "debugger" use+
+ "debugger" add-use
[ [ \ + 1 2 3 4 ] ]
[
{ [ 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+
continuations peg peg.parsers unicode.categories multiline\r
splitting accessors effects sequences.deep peg.search\r
combinators.short-circuit lexer io.streams.string stack-checker\r
-io combinators parser summary ;\r
+io combinators parser vocabs.parser summary ;\r
IN: peg.ebnf\r
\r
: rule ( name word -- parser )\r
{ $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 ;"
! 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 ;
<<
"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"
{ +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 }
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" } }
{ $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." }
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
[
[ 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
\ No newline at end of file
: 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
[ <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 [ ] [
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
-USING: help.markup help.syntax parser ;
+USING: help.markup help.syntax parser strings words ;
IN: vocabs.parser
ARTICLE: "vocabulary-search-shadow" "Shadowing word names"
{ $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 ;
! 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 ;
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 ;
[ 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 ;
dup string? [ "Vocabulary name must be a string" throw ] unless ;
: set-in ( name -- )
- check-vocab-string dup in set create-vocab (use+) ;
\ No newline at end of file
+ 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 ;
\ No newline at end of file
{ $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
[ 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 -- )
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>
projects / factor.git / commitdiff