Merge git://factorcode.org/git/factor
commit
7d6cb82b11
|
@ -1,184 +1,184 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel parser words arrays strings math.parser sequences
|
||||
quotations vectors namespaces math assocs continuations peg ;
|
||||
IN: peg.ebnf
|
||||
|
||||
TUPLE: ebnf-non-terminal symbol ;
|
||||
TUPLE: ebnf-terminal symbol ;
|
||||
TUPLE: ebnf-choice options ;
|
||||
TUPLE: ebnf-sequence elements ;
|
||||
TUPLE: ebnf-repeat0 group ;
|
||||
TUPLE: ebnf-optional elements ;
|
||||
TUPLE: ebnf-rule symbol elements ;
|
||||
TUPLE: ebnf-action word ;
|
||||
TUPLE: ebnf rules ;
|
||||
|
||||
C: <ebnf-non-terminal> ebnf-non-terminal
|
||||
C: <ebnf-terminal> ebnf-terminal
|
||||
C: <ebnf-choice> ebnf-choice
|
||||
C: <ebnf-sequence> ebnf-sequence
|
||||
C: <ebnf-repeat0> ebnf-repeat0
|
||||
C: <ebnf-optional> ebnf-optional
|
||||
C: <ebnf-rule> ebnf-rule
|
||||
C: <ebnf-action> ebnf-action
|
||||
C: <ebnf> ebnf
|
||||
|
||||
SYMBOL: parsers
|
||||
SYMBOL: non-terminals
|
||||
SYMBOL: last-parser
|
||||
|
||||
: reset-parser-generation ( -- )
|
||||
V{ } clone parsers set
|
||||
H{ } clone non-terminals set
|
||||
f last-parser set ;
|
||||
|
||||
: store-parser ( parser -- number )
|
||||
parsers get [ push ] keep length 1- ;
|
||||
|
||||
: get-parser ( index -- parser )
|
||||
parsers get nth ;
|
||||
|
||||
: non-terminal-index ( name -- number )
|
||||
dup non-terminals get at [
|
||||
nip
|
||||
] [
|
||||
f store-parser [ swap non-terminals get set-at ] keep
|
||||
] if* ;
|
||||
|
||||
GENERIC: (generate-parser) ( ast -- id )
|
||||
|
||||
: generate-parser ( ast -- id )
|
||||
(generate-parser) dup last-parser set ;
|
||||
|
||||
M: ebnf-terminal (generate-parser) ( ast -- id )
|
||||
ebnf-terminal-symbol token sp store-parser ;
|
||||
|
||||
M: ebnf-non-terminal (generate-parser) ( ast -- id )
|
||||
[
|
||||
ebnf-non-terminal-symbol dup non-terminal-index ,
|
||||
parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
|
||||
] [ ] make delay sp store-parser ;
|
||||
|
||||
M: ebnf-choice (generate-parser) ( ast -- id )
|
||||
ebnf-choice-options [
|
||||
generate-parser get-parser
|
||||
] map choice store-parser ;
|
||||
|
||||
M: ebnf-sequence (generate-parser) ( ast -- id )
|
||||
ebnf-sequence-elements [
|
||||
generate-parser get-parser
|
||||
] map seq store-parser ;
|
||||
|
||||
M: ebnf-repeat0 (generate-parser) ( ast -- id )
|
||||
ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
|
||||
|
||||
M: ebnf-optional (generate-parser) ( ast -- id )
|
||||
ebnf-optional-elements generate-parser get-parser optional store-parser ;
|
||||
|
||||
M: ebnf-rule (generate-parser) ( ast -- id )
|
||||
dup ebnf-rule-symbol non-terminal-index swap
|
||||
ebnf-rule-elements generate-parser get-parser ! nt-id body
|
||||
swap [ parsers get set-nth ] keep ;
|
||||
|
||||
M: ebnf-action (generate-parser) ( ast -- id )
|
||||
ebnf-action-word search 1quotation
|
||||
last-parser get get-parser swap action store-parser ;
|
||||
|
||||
M: vector (generate-parser) ( ast -- id )
|
||||
[ generate-parser ] map peek ;
|
||||
|
||||
M: f (generate-parser) ( ast -- id )
|
||||
drop last-parser get ;
|
||||
|
||||
M: ebnf (generate-parser) ( ast -- id )
|
||||
ebnf-rules [
|
||||
generate-parser
|
||||
] map peek ;
|
||||
|
||||
DEFER: 'rhs'
|
||||
|
||||
: 'non-terminal' ( -- parser )
|
||||
CHAR: a CHAR: z range repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||
|
||||
: 'terminal' ( -- parser )
|
||||
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
|
||||
|
||||
: 'element' ( -- parser )
|
||||
'non-terminal' 'terminal' 2array choice ;
|
||||
|
||||
DEFER: 'choice'
|
||||
|
||||
: 'group' ( -- parser )
|
||||
"(" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
")" token sp hide
|
||||
3array seq [ first ] action ;
|
||||
|
||||
: 'repeat0' ( -- parser )
|
||||
"{" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
"}" token sp hide
|
||||
3array seq [ first <ebnf-repeat0> ] action ;
|
||||
|
||||
: 'optional' ( -- parser )
|
||||
"[" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
"]" token sp hide
|
||||
3array seq [ first <ebnf-optional> ] action ;
|
||||
|
||||
: 'sequence' ( -- parser )
|
||||
[
|
||||
'element' sp ,
|
||||
'group' sp ,
|
||||
'repeat0' sp ,
|
||||
'optional' sp ,
|
||||
] { } make choice
|
||||
repeat1 [
|
||||
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
||||
] action ;
|
||||
|
||||
: 'choice' ( -- parser )
|
||||
'sequence' sp "|" token sp list-of [
|
||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||
] action ;
|
||||
|
||||
: 'action' ( -- parser )
|
||||
"=>" token hide
|
||||
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
|
||||
2array seq [ first <ebnf-action> ] action ;
|
||||
|
||||
: 'rhs' ( -- parser )
|
||||
'choice' 'action' sp optional 2array seq ;
|
||||
|
||||
: 'rule' ( -- parser )
|
||||
'non-terminal' [ ebnf-non-terminal-symbol ] action
|
||||
"=" token sp hide
|
||||
'rhs'
|
||||
3array seq [ first2 <ebnf-rule> ] action ;
|
||||
|
||||
: 'ebnf' ( -- parser )
|
||||
'rule' sp "." token sp hide list-of [ <ebnf> ] action ;
|
||||
|
||||
: ebnf>quot ( string -- quot )
|
||||
'ebnf' parse [
|
||||
parse-result-ast [
|
||||
reset-parser-generation
|
||||
generate-parser drop
|
||||
[
|
||||
non-terminals get
|
||||
[
|
||||
get-parser [
|
||||
swap , \ in , \ get , \ create ,
|
||||
1quotation , \ define-compound ,
|
||||
] [
|
||||
drop
|
||||
] if*
|
||||
] assoc-each
|
||||
] [ ] make
|
||||
] with-scope
|
||||
] [
|
||||
f
|
||||
] if* ;
|
||||
|
||||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel parser words arrays strings math.parser sequences
|
||||
quotations vectors namespaces math assocs continuations peg ;
|
||||
IN: peg.ebnf
|
||||
|
||||
TUPLE: ebnf-non-terminal symbol ;
|
||||
TUPLE: ebnf-terminal symbol ;
|
||||
TUPLE: ebnf-choice options ;
|
||||
TUPLE: ebnf-sequence elements ;
|
||||
TUPLE: ebnf-repeat0 group ;
|
||||
TUPLE: ebnf-optional elements ;
|
||||
TUPLE: ebnf-rule symbol elements ;
|
||||
TUPLE: ebnf-action word ;
|
||||
TUPLE: ebnf rules ;
|
||||
|
||||
C: <ebnf-non-terminal> ebnf-non-terminal
|
||||
C: <ebnf-terminal> ebnf-terminal
|
||||
C: <ebnf-choice> ebnf-choice
|
||||
C: <ebnf-sequence> ebnf-sequence
|
||||
C: <ebnf-repeat0> ebnf-repeat0
|
||||
C: <ebnf-optional> ebnf-optional
|
||||
C: <ebnf-rule> ebnf-rule
|
||||
C: <ebnf-action> ebnf-action
|
||||
C: <ebnf> ebnf
|
||||
|
||||
SYMBOL: parsers
|
||||
SYMBOL: non-terminals
|
||||
SYMBOL: last-parser
|
||||
|
||||
: reset-parser-generation ( -- )
|
||||
V{ } clone parsers set
|
||||
H{ } clone non-terminals set
|
||||
f last-parser set ;
|
||||
|
||||
: store-parser ( parser -- number )
|
||||
parsers get [ push ] keep length 1- ;
|
||||
|
||||
: get-parser ( index -- parser )
|
||||
parsers get nth ;
|
||||
|
||||
: non-terminal-index ( name -- number )
|
||||
dup non-terminals get at [
|
||||
nip
|
||||
] [
|
||||
f store-parser [ swap non-terminals get set-at ] keep
|
||||
] if* ;
|
||||
|
||||
GENERIC: (generate-parser) ( ast -- id )
|
||||
|
||||
: generate-parser ( ast -- id )
|
||||
(generate-parser) dup last-parser set ;
|
||||
|
||||
M: ebnf-terminal (generate-parser) ( ast -- id )
|
||||
ebnf-terminal-symbol token sp store-parser ;
|
||||
|
||||
M: ebnf-non-terminal (generate-parser) ( ast -- id )
|
||||
[
|
||||
ebnf-non-terminal-symbol dup non-terminal-index ,
|
||||
parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
|
||||
] [ ] make delay sp store-parser ;
|
||||
|
||||
M: ebnf-choice (generate-parser) ( ast -- id )
|
||||
ebnf-choice-options [
|
||||
generate-parser get-parser
|
||||
] map choice store-parser ;
|
||||
|
||||
M: ebnf-sequence (generate-parser) ( ast -- id )
|
||||
ebnf-sequence-elements [
|
||||
generate-parser get-parser
|
||||
] map seq store-parser ;
|
||||
|
||||
M: ebnf-repeat0 (generate-parser) ( ast -- id )
|
||||
ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
|
||||
|
||||
M: ebnf-optional (generate-parser) ( ast -- id )
|
||||
ebnf-optional-elements generate-parser get-parser optional store-parser ;
|
||||
|
||||
M: ebnf-rule (generate-parser) ( ast -- id )
|
||||
dup ebnf-rule-symbol non-terminal-index swap
|
||||
ebnf-rule-elements generate-parser get-parser ! nt-id body
|
||||
swap [ parsers get set-nth ] keep ;
|
||||
|
||||
M: ebnf-action (generate-parser) ( ast -- id )
|
||||
ebnf-action-word search 1quotation
|
||||
last-parser get get-parser swap action store-parser ;
|
||||
|
||||
M: vector (generate-parser) ( ast -- id )
|
||||
[ generate-parser ] map peek ;
|
||||
|
||||
M: f (generate-parser) ( ast -- id )
|
||||
drop last-parser get ;
|
||||
|
||||
M: ebnf (generate-parser) ( ast -- id )
|
||||
ebnf-rules [
|
||||
generate-parser
|
||||
] map peek ;
|
||||
|
||||
DEFER: 'rhs'
|
||||
|
||||
: 'non-terminal' ( -- parser )
|
||||
CHAR: a CHAR: z range repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||
|
||||
: 'terminal' ( -- parser )
|
||||
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
|
||||
|
||||
: 'element' ( -- parser )
|
||||
'non-terminal' 'terminal' 2array choice ;
|
||||
|
||||
DEFER: 'choice'
|
||||
|
||||
: 'group' ( -- parser )
|
||||
"(" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
")" token sp hide
|
||||
3array seq [ first ] action ;
|
||||
|
||||
: 'repeat0' ( -- parser )
|
||||
"{" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
"}" token sp hide
|
||||
3array seq [ first <ebnf-repeat0> ] action ;
|
||||
|
||||
: 'optional' ( -- parser )
|
||||
"[" token sp hide
|
||||
[ 'choice' sp ] delay
|
||||
"]" token sp hide
|
||||
3array seq [ first <ebnf-optional> ] action ;
|
||||
|
||||
: 'sequence' ( -- parser )
|
||||
[
|
||||
'element' sp ,
|
||||
'group' sp ,
|
||||
'repeat0' sp ,
|
||||
'optional' sp ,
|
||||
] { } make choice
|
||||
repeat1 [
|
||||
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
||||
] action ;
|
||||
|
||||
: 'choice' ( -- parser )
|
||||
'sequence' sp "|" token sp list-of [
|
||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||
] action ;
|
||||
|
||||
: 'action' ( -- parser )
|
||||
"=>" token hide
|
||||
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
|
||||
2array seq [ first <ebnf-action> ] action ;
|
||||
|
||||
: 'rhs' ( -- parser )
|
||||
'choice' 'action' sp optional 2array seq ;
|
||||
|
||||
: 'rule' ( -- parser )
|
||||
'non-terminal' [ ebnf-non-terminal-symbol ] action
|
||||
"=" token sp hide
|
||||
'rhs'
|
||||
3array seq [ first2 <ebnf-rule> ] action ;
|
||||
|
||||
: 'ebnf' ( -- parser )
|
||||
'rule' sp "." token sp hide list-of [ <ebnf> ] action ;
|
||||
|
||||
: ebnf>quot ( string -- quot )
|
||||
'ebnf' parse [
|
||||
parse-result-ast [
|
||||
reset-parser-generation
|
||||
generate-parser drop
|
||||
[
|
||||
non-terminals get
|
||||
[
|
||||
get-parser [
|
||||
swap , \ in , \ get , \ create ,
|
||||
1quotation , \ define ,
|
||||
] [
|
||||
drop
|
||||
] if*
|
||||
] assoc-each
|
||||
] [ ] make
|
||||
] with-scope
|
||||
] [
|
||||
f
|
||||
] if* ;
|
||||
|
||||
: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
|
|
@ -1,142 +1,143 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax peg ;
|
||||
|
||||
HELP: parse
|
||||
{ $values
|
||||
{ "input" "a string" }
|
||||
{ "parser" "a parser" }
|
||||
{ "result" "a parse-result or f" }
|
||||
}
|
||||
{ $description
|
||||
"Given the input string, parse it using the given parser. The result is a <parse-result> object if "
|
||||
"the parse was successful, otherwise it is f." } ;
|
||||
|
||||
HELP: token
|
||||
{ $values
|
||||
{ "string" "a string" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that matches the given string." } ;
|
||||
|
||||
HELP: satisfy
|
||||
{ $values
|
||||
{ "quot" "a quotation" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the quotation on the first character of the input string, "
|
||||
"succeeding if that quotation returns true. The AST is the character from the string." } ;
|
||||
|
||||
HELP: range
|
||||
{ $values
|
||||
{ "min" "a character" }
|
||||
{ "max" "a character" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
|
||||
{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;
|
||||
|
||||
HELP: seq
|
||||
{ $values
|
||||
{ "seq" "a sequence of parsers" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "
|
||||
"all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "
|
||||
"the individual parsers." } ;
|
||||
|
||||
HELP: choice
|
||||
{ $values
|
||||
{ "seq" "a sequence of parsers" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. "
|
||||
"The resulting AST is that produced by the successful parser." } ;
|
||||
|
||||
HELP: repeat0
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
|
||||
"an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "
|
||||
"parsed." } ;
|
||||
|
||||
HELP: repeat1
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "
|
||||
"an array of the AST produced by the 'p1' parser." } ;
|
||||
|
||||
HELP: optional
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "
|
||||
"'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;
|
||||
|
||||
HELP: ensure
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
|
||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||
"disambiguation, along with the " { $link ensure-not } " word." }
|
||||
{ $examples { $code "\"0\" token ensure octal-parser" } } ;
|
||||
|
||||
HELP: ensure-not
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
|
||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||
"disambiguation, along with the " { $link ensure } " word." }
|
||||
{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
|
||||
|
||||
HELP: action
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
{ "quot" "a quotation with stack effect ( ast -- ast )" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "
|
||||
"from that parse. The result of the quotation is then used as the final AST. This can be used "
|
||||
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
|
||||
"the default AST." }
|
||||
{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
|
||||
|
||||
HELP: sp
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the original parser 'p1' after stripping any whitespace "
|
||||
" from the left of the input string." } ;
|
||||
|
||||
HELP: hide
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the original parser succeeds, but does not "
|
||||
"put any result in the AST. Useful for ignoring 'syntax' in the AST." }
|
||||
{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;
|
||||
|
||||
HELP: delay
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Delays the construction of a parser until it is actually required to parse. This "
|
||||
"allows for calling a parser that results in a recursive call to itself. The quotation "
|
||||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax ;
|
||||
IN: peg
|
||||
|
||||
HELP: parse
|
||||
{ $values
|
||||
{ "input" "a string" }
|
||||
{ "parser" "a parser" }
|
||||
{ "result" "a parse-result or f" }
|
||||
}
|
||||
{ $description
|
||||
"Given the input string, parse it using the given parser. The result is a <parse-result> object if "
|
||||
"the parse was successful, otherwise it is f." } ;
|
||||
|
||||
HELP: token
|
||||
{ $values
|
||||
{ "string" "a string" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that matches the given string." } ;
|
||||
|
||||
HELP: satisfy
|
||||
{ $values
|
||||
{ "quot" "a quotation" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the quotation on the first character of the input string, "
|
||||
"succeeding if that quotation returns true. The AST is the character from the string." } ;
|
||||
|
||||
HELP: range
|
||||
{ $values
|
||||
{ "min" "a character" }
|
||||
{ "max" "a character" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
|
||||
{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;
|
||||
|
||||
HELP: seq
|
||||
{ $values
|
||||
{ "seq" "a sequence of parsers" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "
|
||||
"all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "
|
||||
"the individual parsers." } ;
|
||||
|
||||
HELP: choice
|
||||
{ $values
|
||||
{ "seq" "a sequence of parsers" }
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that will try all the parsers in the sequence, in order, until one succeeds. "
|
||||
"The resulting AST is that produced by the successful parser." } ;
|
||||
|
||||
HELP: repeat0
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
|
||||
"an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "
|
||||
"parsed." } ;
|
||||
|
||||
HELP: repeat1
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "
|
||||
"an array of the AST produced by the 'p1' parser." } ;
|
||||
|
||||
HELP: optional
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "
|
||||
"'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;
|
||||
|
||||
HELP: ensure
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
|
||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||
"disambiguation, along with the " { $link ensure-not } " word." }
|
||||
{ $examples { $code "\"0\" token ensure octal-parser" } } ;
|
||||
|
||||
HELP: ensure-not
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
|
||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||
"disambiguation, along with the " { $link ensure } " word." }
|
||||
{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
|
||||
|
||||
HELP: action
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
{ "quot" "a quotation with stack effect ( ast -- ast )" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "
|
||||
"from that parse. The result of the quotation is then used as the final AST. This can be used "
|
||||
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
|
||||
"the default AST." }
|
||||
{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
|
||||
|
||||
HELP: sp
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that calls the original parser 'p1' after stripping any whitespace "
|
||||
" from the left of the input string." } ;
|
||||
|
||||
HELP: hide
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Returns a parser that succeeds if the original parser succeeds, but does not "
|
||||
"put any result in the AST. Useful for ignoring 'syntax' in the AST." }
|
||||
{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;
|
||||
|
||||
HELP: delay
|
||||
{ $values
|
||||
{ "parser" "a parser" }
|
||||
}
|
||||
{ $description
|
||||
"Delays the construction of a parser until it is actually required to parse. This "
|
||||
"allows for calling a parser that results in a recursive call to itself. The quotation "
|
||||
"should return the constructed parser." } ;
|
|
@ -1 +0,0 @@
|
|||
Daniel Ehrenberg
|
|
@ -1 +0,0 @@
|
|||
Double-dispatch generic words
|
|
@ -1 +0,0 @@
|
|||
extensions
|
|
@ -1,18 +0,0 @@
|
|||
USING: visitor math sequences math.parser strings tools.test kernel ;
|
||||
|
||||
VISITOR: ++ ( object object -- object )
|
||||
! acts like +, coercing string arguments to a number, unless both arguments are strings, in which case it appends them
|
||||
|
||||
V: number string ++
|
||||
string>number + ;
|
||||
V: string number ++
|
||||
>r string>number r> + ;
|
||||
V: number number ++
|
||||
+ ;
|
||||
V: string string ++
|
||||
append ;
|
||||
|
||||
[ 3 ] [ 1 2 ++ ] unit-test
|
||||
[ 3 ] [ "1" 2 ++ ] unit-test
|
||||
[ 3 ] [ 1 "2" ++ ] unit-test
|
||||
[ "12" ] [ "1" "2" ++ ] unit-test
|
|
@ -1,63 +0,0 @@
|
|||
USING: kernel generic.standard syntax words parser assocs
|
||||
generic quotations sequences effects arrays classes definitions
|
||||
prettyprint sorting prettyprint.backend shuffle ;
|
||||
IN: visitor
|
||||
|
||||
: define-visitor ( word -- )
|
||||
dup dup reset-word define-simple-generic
|
||||
dup H{ } clone "visitor-methods" set-word-prop
|
||||
H{ } clone "visitors" set-word-prop ;
|
||||
|
||||
: VISITOR:
|
||||
CREATE define-visitor ; parsing
|
||||
|
||||
: record-visitor ( top-class generic method-word -- )
|
||||
swap "visitors" word-prop swapd set-at ;
|
||||
|
||||
: define-1generic ( word -- )
|
||||
1 <standard-combination> define-generic ;
|
||||
|
||||
: copy-effect ( from to -- )
|
||||
swap stack-effect "declared-effect" set-word-prop ;
|
||||
|
||||
: new-vmethod ( method bottom-class top-class generic -- )
|
||||
gensym dup define-1generic
|
||||
2dup copy-effect
|
||||
3dup 1quotation -rot define-method
|
||||
[ record-visitor ] keep
|
||||
define-method ;
|
||||
|
||||
: define-visitor-method ( method bottom-class top-class generic -- )
|
||||
4dup >r 2array r> "visitor-methods" word-prop set-at
|
||||
2dup "visitors" word-prop at
|
||||
[ nip define-method ] [ new-vmethod ] ?if ;
|
||||
|
||||
: V:
|
||||
! syntax: V: bottom-class top-class generic body... ;
|
||||
f set-word scan-word scan-word scan-word
|
||||
parse-definition -roll define-visitor-method ; parsing
|
||||
|
||||
! see instance:
|
||||
! see must be redone because "methods" doesn't show methods
|
||||
|
||||
PREDICATE: standard-generic visitor "visitors" word-prop ;
|
||||
PREDICATE: array triple length 3 = ;
|
||||
PREDICATE: triple visitor-spec
|
||||
first3 visitor? >r [ class? ] both? r> and ;
|
||||
|
||||
M: visitor-spec definer drop \ V: \ ; ;
|
||||
M: visitor definer drop \ VISITOR: f ;
|
||||
|
||||
M: visitor-spec synopsis*
|
||||
! same as method-spec#synopsis*
|
||||
dup definer drop pprint-word
|
||||
[ pprint-word ] each ;
|
||||
|
||||
M: visitor-spec definition
|
||||
first3 >r 2array r> "visitor-methods" word-prop at ;
|
||||
|
||||
M: visitor see
|
||||
dup (see)
|
||||
dup see-class
|
||||
dup "visitor-methods" word-prop keys natural-sort swap
|
||||
[ >r first2 r> 3array ] curry map see-all ;
|
Loading…
Reference in New Issue