Merge git://factorcode.org/git/factor
Doug Coleman
commit
7d6cb82b11
|
|
@ -1,184 +1,184 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel parser words arrays strings math.parser sequences
|
USING: kernel parser words arrays strings math.parser sequences
|
||||||
quotations vectors namespaces math assocs continuations peg ;
|
quotations vectors namespaces math assocs continuations peg ;
|
||||||
IN: peg.ebnf
|
IN: peg.ebnf
|
||||||
|
|
||||||
TUPLE: ebnf-non-terminal symbol ;
|
TUPLE: ebnf-non-terminal symbol ;
|
||||||
TUPLE: ebnf-terminal symbol ;
|
TUPLE: ebnf-terminal symbol ;
|
||||||
TUPLE: ebnf-choice options ;
|
TUPLE: ebnf-choice options ;
|
||||||
TUPLE: ebnf-sequence elements ;
|
TUPLE: ebnf-sequence elements ;
|
||||||
TUPLE: ebnf-repeat0 group ;
|
TUPLE: ebnf-repeat0 group ;
|
||||||
TUPLE: ebnf-optional elements ;
|
TUPLE: ebnf-optional elements ;
|
||||||
TUPLE: ebnf-rule symbol elements ;
|
TUPLE: ebnf-rule symbol elements ;
|
||||||
TUPLE: ebnf-action word ;
|
TUPLE: ebnf-action word ;
|
||||||
TUPLE: ebnf rules ;
|
TUPLE: ebnf rules ;
|
||||||
|
|
||||||
C: <ebnf-non-terminal> ebnf-non-terminal
|
C: <ebnf-non-terminal> ebnf-non-terminal
|
||||||
C: <ebnf-terminal> ebnf-terminal
|
C: <ebnf-terminal> ebnf-terminal
|
||||||
C: <ebnf-choice> ebnf-choice
|
C: <ebnf-choice> ebnf-choice
|
||||||
C: <ebnf-sequence> ebnf-sequence
|
C: <ebnf-sequence> ebnf-sequence
|
||||||
C: <ebnf-repeat0> ebnf-repeat0
|
C: <ebnf-repeat0> ebnf-repeat0
|
||||||
C: <ebnf-optional> ebnf-optional
|
C: <ebnf-optional> ebnf-optional
|
||||||
C: <ebnf-rule> ebnf-rule
|
C: <ebnf-rule> ebnf-rule
|
||||||
C: <ebnf-action> ebnf-action
|
C: <ebnf-action> ebnf-action
|
||||||
C: <ebnf> ebnf
|
C: <ebnf> ebnf
|
||||||
|
|
||||||
SYMBOL: parsers
|
SYMBOL: parsers
|
||||||
SYMBOL: non-terminals
|
SYMBOL: non-terminals
|
||||||
SYMBOL: last-parser
|
SYMBOL: last-parser
|
||||||
|
|
||||||
: reset-parser-generation ( -- )
|
: reset-parser-generation ( -- )
|
||||||
V{ } clone parsers set
|
V{ } clone parsers set
|
||||||
H{ } clone non-terminals set
|
H{ } clone non-terminals set
|
||||||
f last-parser set ;
|
f last-parser set ;
|
||||||
|
|
||||||
: store-parser ( parser -- number )
|
: store-parser ( parser -- number )
|
||||||
parsers get [ push ] keep length 1- ;
|
parsers get [ push ] keep length 1- ;
|
||||||
|
|
||||||
: get-parser ( index -- parser )
|
: get-parser ( index -- parser )
|
||||||
parsers get nth ;
|
parsers get nth ;
|
||||||
|
|
||||||
: non-terminal-index ( name -- number )
|
: non-terminal-index ( name -- number )
|
||||||
dup non-terminals get at [
|
dup non-terminals get at [
|
||||||
nip
|
nip
|
||||||
] [
|
] [
|
||||||
f store-parser [ swap non-terminals get set-at ] keep
|
f store-parser [ swap non-terminals get set-at ] keep
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
||||||
GENERIC: (generate-parser) ( ast -- id )
|
GENERIC: (generate-parser) ( ast -- id )
|
||||||
|
|
||||||
: generate-parser ( ast -- id )
|
: generate-parser ( ast -- id )
|
||||||
(generate-parser) dup last-parser set ;
|
(generate-parser) dup last-parser set ;
|
||||||
|
|
||||||
M: ebnf-terminal (generate-parser) ( ast -- id )
|
M: ebnf-terminal (generate-parser) ( ast -- id )
|
||||||
ebnf-terminal-symbol token sp store-parser ;
|
ebnf-terminal-symbol token sp store-parser ;
|
||||||
|
|
||||||
M: ebnf-non-terminal (generate-parser) ( ast -- id )
|
M: ebnf-non-terminal (generate-parser) ( ast -- id )
|
||||||
[
|
[
|
||||||
ebnf-non-terminal-symbol dup non-terminal-index ,
|
ebnf-non-terminal-symbol dup non-terminal-index ,
|
||||||
parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
|
parsers get , \ nth , [ search ] [ 2drop f ] recover , \ or ,
|
||||||
] [ ] make delay sp store-parser ;
|
] [ ] make delay sp store-parser ;
|
||||||
|
|
||||||
M: ebnf-choice (generate-parser) ( ast -- id )
|
M: ebnf-choice (generate-parser) ( ast -- id )
|
||||||
ebnf-choice-options [
|
ebnf-choice-options [
|
||||||
generate-parser get-parser
|
generate-parser get-parser
|
||||||
] map choice store-parser ;
|
] map choice store-parser ;
|
||||||
|
|
||||||
M: ebnf-sequence (generate-parser) ( ast -- id )
|
M: ebnf-sequence (generate-parser) ( ast -- id )
|
||||||
ebnf-sequence-elements [
|
ebnf-sequence-elements [
|
||||||
generate-parser get-parser
|
generate-parser get-parser
|
||||||
] map seq store-parser ;
|
] map seq store-parser ;
|
||||||
|
|
||||||
M: ebnf-repeat0 (generate-parser) ( ast -- id )
|
M: ebnf-repeat0 (generate-parser) ( ast -- id )
|
||||||
ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
|
ebnf-repeat0-group generate-parser get-parser repeat0 store-parser ;
|
||||||
|
|
||||||
M: ebnf-optional (generate-parser) ( ast -- id )
|
M: ebnf-optional (generate-parser) ( ast -- id )
|
||||||
ebnf-optional-elements generate-parser get-parser optional store-parser ;
|
ebnf-optional-elements generate-parser get-parser optional store-parser ;
|
||||||
|
|
||||||
M: ebnf-rule (generate-parser) ( ast -- id )
|
M: ebnf-rule (generate-parser) ( ast -- id )
|
||||||
dup ebnf-rule-symbol non-terminal-index swap
|
dup ebnf-rule-symbol non-terminal-index swap
|
||||||
ebnf-rule-elements generate-parser get-parser ! nt-id body
|
ebnf-rule-elements generate-parser get-parser ! nt-id body
|
||||||
swap [ parsers get set-nth ] keep ;
|
swap [ parsers get set-nth ] keep ;
|
||||||
|
|
||||||
M: ebnf-action (generate-parser) ( ast -- id )
|
M: ebnf-action (generate-parser) ( ast -- id )
|
||||||
ebnf-action-word search 1quotation
|
ebnf-action-word search 1quotation
|
||||||
last-parser get get-parser swap action store-parser ;
|
last-parser get get-parser swap action store-parser ;
|
||||||
|
|
||||||
M: vector (generate-parser) ( ast -- id )
|
M: vector (generate-parser) ( ast -- id )
|
||||||
[ generate-parser ] map peek ;
|
[ generate-parser ] map peek ;
|
||||||
|
|
||||||
M: f (generate-parser) ( ast -- id )
|
M: f (generate-parser) ( ast -- id )
|
||||||
drop last-parser get ;
|
drop last-parser get ;
|
||||||
|
|
||||||
M: ebnf (generate-parser) ( ast -- id )
|
M: ebnf (generate-parser) ( ast -- id )
|
||||||
ebnf-rules [
|
ebnf-rules [
|
||||||
generate-parser
|
generate-parser
|
||||||
] map peek ;
|
] map peek ;
|
||||||
|
|
||||||
DEFER: 'rhs'
|
DEFER: 'rhs'
|
||||||
|
|
||||||
: 'non-terminal' ( -- parser )
|
: 'non-terminal' ( -- parser )
|
||||||
CHAR: a CHAR: z range repeat1 [ >string <ebnf-non-terminal> ] action ;
|
CHAR: a CHAR: z range repeat1 [ >string <ebnf-non-terminal> ] action ;
|
||||||
|
|
||||||
: 'terminal' ( -- parser )
|
: 'terminal' ( -- parser )
|
||||||
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
|
"'" token hide [ CHAR: ' = not ] satisfy repeat1 "'" token hide 3array seq [ first >string <ebnf-terminal> ] action ;
|
||||||
|
|
||||||
: 'element' ( -- parser )
|
: 'element' ( -- parser )
|
||||||
'non-terminal' 'terminal' 2array choice ;
|
'non-terminal' 'terminal' 2array choice ;
|
||||||
|
|
||||||
DEFER: 'choice'
|
DEFER: 'choice'
|
||||||
|
|
||||||
: 'group' ( -- parser )
|
: 'group' ( -- parser )
|
||||||
"(" token sp hide
|
"(" token sp hide
|
||||||
[ 'choice' sp ] delay
|
[ 'choice' sp ] delay
|
||||||
")" token sp hide
|
")" token sp hide
|
||||||
3array seq [ first ] action ;
|
3array seq [ first ] action ;
|
||||||
|
|
||||||
: 'repeat0' ( -- parser )
|
: 'repeat0' ( -- parser )
|
||||||
"{" token sp hide
|
"{" token sp hide
|
||||||
[ 'choice' sp ] delay
|
[ 'choice' sp ] delay
|
||||||
"}" token sp hide
|
"}" token sp hide
|
||||||
3array seq [ first <ebnf-repeat0> ] action ;
|
3array seq [ first <ebnf-repeat0> ] action ;
|
||||||
|
|
||||||
: 'optional' ( -- parser )
|
: 'optional' ( -- parser )
|
||||||
"[" token sp hide
|
"[" token sp hide
|
||||||
[ 'choice' sp ] delay
|
[ 'choice' sp ] delay
|
||||||
"]" token sp hide
|
"]" token sp hide
|
||||||
3array seq [ first <ebnf-optional> ] action ;
|
3array seq [ first <ebnf-optional> ] action ;
|
||||||
|
|
||||||
: 'sequence' ( -- parser )
|
: 'sequence' ( -- parser )
|
||||||
[
|
[
|
||||||
'element' sp ,
|
'element' sp ,
|
||||||
'group' sp ,
|
'group' sp ,
|
||||||
'repeat0' sp ,
|
'repeat0' sp ,
|
||||||
'optional' sp ,
|
'optional' sp ,
|
||||||
] { } make choice
|
] { } make choice
|
||||||
repeat1 [
|
repeat1 [
|
||||||
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
dup length 1 = [ first ] [ <ebnf-sequence> ] if
|
||||||
] action ;
|
] action ;
|
||||||
|
|
||||||
: 'choice' ( -- parser )
|
: 'choice' ( -- parser )
|
||||||
'sequence' sp "|" token sp list-of [
|
'sequence' sp "|" token sp list-of [
|
||||||
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
dup length 1 = [ first ] [ <ebnf-choice> ] if
|
||||||
] action ;
|
] action ;
|
||||||
|
|
||||||
: 'action' ( -- parser )
|
: 'action' ( -- parser )
|
||||||
"=>" token hide
|
"=>" token hide
|
||||||
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
|
[ blank? ] satisfy ensure-not [ drop t ] satisfy 2array seq [ first ] action repeat1 [ >string ] action sp
|
||||||
2array seq [ first <ebnf-action> ] action ;
|
2array seq [ first <ebnf-action> ] action ;
|
||||||
|
|
||||||
: 'rhs' ( -- parser )
|
: 'rhs' ( -- parser )
|
||||||
'choice' 'action' sp optional 2array seq ;
|
'choice' 'action' sp optional 2array seq ;
|
||||||
|
|
||||||
: 'rule' ( -- parser )
|
: 'rule' ( -- parser )
|
||||||
'non-terminal' [ ebnf-non-terminal-symbol ] action
|
'non-terminal' [ ebnf-non-terminal-symbol ] action
|
||||||
"=" token sp hide
|
"=" token sp hide
|
||||||
'rhs'
|
'rhs'
|
||||||
3array seq [ first2 <ebnf-rule> ] action ;
|
3array seq [ first2 <ebnf-rule> ] action ;
|
||||||
|
|
||||||
: 'ebnf' ( -- parser )
|
: 'ebnf' ( -- parser )
|
||||||
'rule' sp "." token sp hide list-of [ <ebnf> ] action ;
|
'rule' sp "." token sp hide list-of [ <ebnf> ] action ;
|
||||||
|
|
||||||
: ebnf>quot ( string -- quot )
|
: ebnf>quot ( string -- quot )
|
||||||
'ebnf' parse [
|
'ebnf' parse [
|
||||||
parse-result-ast [
|
parse-result-ast [
|
||||||
reset-parser-generation
|
reset-parser-generation
|
||||||
generate-parser drop
|
generate-parser drop
|
||||||
[
|
[
|
||||||
non-terminals get
|
non-terminals get
|
||||||
[
|
[
|
||||||
get-parser [
|
get-parser [
|
||||||
swap , \ in , \ get , \ create ,
|
swap , \ in , \ get , \ create ,
|
||||||
1quotation , \ define-compound ,
|
1quotation , \ define ,
|
||||||
] [
|
] [
|
||||||
drop
|
drop
|
||||||
] if*
|
] if*
|
||||||
] assoc-each
|
] assoc-each
|
||||||
] [ ] make
|
] [ ] make
|
||||||
] with-scope
|
] with-scope
|
||||||
] [
|
] [
|
||||||
f
|
f
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
||||||
: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
|
: <EBNF "EBNF>" parse-tokens " " join ebnf>quot call ; parsing
|
||||||
|
|
@ -1,142 +1,143 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: help.markup help.syntax peg ;
|
USING: help.markup help.syntax ;
|
||||||
|
IN: peg
|
||||||
HELP: parse
|
|
||||||
{ $values
|
HELP: parse
|
||||||
{ "input" "a string" }
|
{ $values
|
||||||
{ "parser" "a parser" }
|
{ "input" "a string" }
|
||||||
{ "result" "a parse-result or f" }
|
{ "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 "
|
{ $description
|
||||||
"the parse was successful, otherwise it is f." } ;
|
"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
|
HELP: token
|
||||||
{ "string" "a string" }
|
{ $values
|
||||||
{ "parser" "a parser" }
|
{ "string" "a string" }
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that matches the given string." } ;
|
{ $description
|
||||||
|
"Returns a parser that matches the given string." } ;
|
||||||
HELP: satisfy
|
|
||||||
{ $values
|
HELP: satisfy
|
||||||
{ "quot" "a quotation" }
|
{ $values
|
||||||
{ "parser" "a parser" }
|
{ "quot" "a quotation" }
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that calls the quotation on the first character of the input string, "
|
{ $description
|
||||||
"succeeding if that quotation returns true. The AST is the character from the string." } ;
|
"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
|
HELP: range
|
||||||
{ "min" "a character" }
|
{ $values
|
||||||
{ "max" "a character" }
|
{ "min" "a character" }
|
||||||
{ "parser" "a parser" }
|
{ "max" "a character" }
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that matches a single character that lies within the range of characters given, inclusive." }
|
{ $description
|
||||||
{ $examples { $code ": digit ( -- parser ) CHAR: 0 CHAR: 9 range ;" } } ;
|
"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
|
HELP: seq
|
||||||
{ "seq" "a sequence of parsers" }
|
{ $values
|
||||||
{ "parser" "a parser" }
|
{ "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 "
|
{ $description
|
||||||
"all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "
|
"Returns a parser that calls all parsers in the given sequence, in order. The parser succeeds if "
|
||||||
"the individual parsers." } ;
|
"all the parsers succeed, otherwise it fails. The AST produced is a sequence of the AST produced by "
|
||||||
|
"the individual parsers." } ;
|
||||||
HELP: choice
|
|
||||||
{ $values
|
HELP: choice
|
||||||
{ "seq" "a sequence of parsers" }
|
{ $values
|
||||||
{ "parser" "a parser" }
|
{ "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. "
|
{ $description
|
||||||
"The resulting AST is that produced by the successful parser." } ;
|
"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
|
HELP: repeat0
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
|
{ $description
|
||||||
"an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "
|
"Returns a parser that parses 0 or more instances of the 'p1' parser. The AST produced is "
|
||||||
"parsed." } ;
|
"an array of the AST produced by the 'p1' parser. An empty array indicates 0 instances were "
|
||||||
|
"parsed." } ;
|
||||||
HELP: repeat1
|
|
||||||
{ $values
|
HELP: repeat1
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that parses 1 or more instances of the 'p1' parser. The AST produced is "
|
{ $description
|
||||||
"an array of the AST produced by the 'p1' parser." } ;
|
"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
|
HELP: optional
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that parses 0 or 1 instances of the 'p1' parser. The AST produced is "
|
{ $description
|
||||||
"'f' if 0 instances are parsed the AST produced is 'f', otherwise it is the AST produced by 'p1'." } ;
|
"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
|
HELP: ensure
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
|
{ $description
|
||||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
"Returns a parser that succeeds if the 'p1' parser succeeds but does not add anything to the "
|
||||||
"disambiguation, along with the " { $link ensure-not } " word." }
|
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||||
{ $examples { $code "\"0\" token ensure octal-parser" } } ;
|
"disambiguation, along with the " { $link ensure-not } " word." }
|
||||||
|
{ $examples { $code "\"0\" token ensure octal-parser" } } ;
|
||||||
HELP: ensure-not
|
|
||||||
{ $values
|
HELP: ensure-not
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
|
{ $description
|
||||||
"AST and does not move the location in the input string. This can be used for lookahead and "
|
"Returns a parser that succeeds if the 'p1' parser fails but does not add anything to the "
|
||||||
"disambiguation, along with the " { $link ensure } " word." }
|
"AST and does not move the location in the input string. This can be used for lookahead and "
|
||||||
{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
|
"disambiguation, along with the " { $link ensure } " word." }
|
||||||
|
{ $code "\"+\" token \"=\" token ensure-not \"+=\" token 3array seq" } ;
|
||||||
HELP: action
|
|
||||||
{ $values
|
HELP: action
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
{ "quot" "a quotation with stack effect ( ast -- ast )" }
|
{ "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 "
|
{ $description
|
||||||
"from that parse. The result of the quotation is then used as the final AST. This can be used "
|
"Returns a parser that calls the 'p1' parser and applies the quotation to the AST resulting "
|
||||||
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
|
"from that parse. The result of the quotation is then used as the final AST. This can be used "
|
||||||
"the default AST." }
|
"for manipulating the parse tree to produce a AST better suited for the task at hand rather than "
|
||||||
{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
|
"the default AST." }
|
||||||
|
{ $code "CHAR: 0 CHAR: 9 range [ to-digit ] action" } ;
|
||||||
HELP: sp
|
|
||||||
{ $values
|
HELP: sp
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that calls the original parser 'p1' after stripping any whitespace "
|
{ $description
|
||||||
" from the left of the input string." } ;
|
"Returns a parser that calls the original parser 'p1' after stripping any whitespace "
|
||||||
|
" from the left of the input string." } ;
|
||||||
HELP: hide
|
|
||||||
{ $values
|
HELP: hide
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Returns a parser that succeeds if the original parser succeeds, but does not "
|
{ $description
|
||||||
"put any result in the AST. Useful for ignoring 'syntax' in the AST." }
|
"Returns a parser that succeeds if the original parser succeeds, but does not "
|
||||||
{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;
|
"put any result in the AST. Useful for ignoring 'syntax' in the AST." }
|
||||||
|
{ $code "\"[\" token hide number \"]\" token hide 3array seq" } ;
|
||||||
HELP: delay
|
|
||||||
{ $values
|
HELP: delay
|
||||||
{ "parser" "a parser" }
|
{ $values
|
||||||
}
|
{ "parser" "a parser" }
|
||||||
{ $description
|
}
|
||||||
"Delays the construction of a parser until it is actually required to parse. This "
|
{ $description
|
||||||
"allows for calling a parser that results in a recursive call to itself. The quotation "
|
"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." } ;
|
"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