Parse EBNF: Difference between revisions
→{{header|Perl 6}}: Add Perl 6 example
Thundergnat (talk | contribs) (→{{header|Perl 6}}: Add Perl 6 example) |
|||
Line 438:
ch := ' '
END EBNFScanner.</lang>
=={{header|Perl 6}}==
{{works with|Rakudo|2011.07}}
This is a fairly naive implementation of an EBNF parser. It works, but takes some shortcuts and implements a subset of EBNF. The biggest restriction is that identifiers can only contain alpha-numeric characters rather than anything but EBNF operators: |(){}[];,"' So identifiers like <?-&#@>, though technically correct, won't work.
This parses the EBNF rule set using a perl 6 grammar, then if it parses as valid EBNF, constructs a grammar and parses the test strings with that. EBNF rule sets that are naively syntactically correct but missing rules will parse as valid but will give a runtime failure warning about missing methods.
<lang perl6># A perl 6 grammar to parse EBNF
grammar EBNF {
rule TOP { ^^<title>? '{' [ <ruleset> ]+ '}' <comment>?$$ }
rule ruleset { <name> '=' <expression> <[.;]> }
rule expression { <term> ** "|" }
rule term { <factor>+ }
rule factor { <group> | <repeat> | <optional> | <identifier> | <literal> }
rule group { '(' <expression> ')' }
rule repeat { '{' <expression> '}' }
rule optional { '[' <expression> ']' }
token identifier { \w+ }
token literal { "'" <-[']>+ "'" | '"' <-["]>+ '"' } #" bogus comment to defeat confused syntax highlighter
token title { <literal> }
token comment { <literal> }
token name { <identifier> }
}
# And actions to build a EBNF parser
class EBNF::Actions {
method TOP($/) {
my @top;
my $grammar = $/;
$grammar.=subst(/<-[\{]>*\{\s*/, '');
for $grammar.split(/\n\h*\n/)[0] -> $f {
for $f.split(/\n\h*/) -> $g {
next if $g ~~ /^\W/;
@top.push: '<' ~ $g.split(' =')[0] ~ '>';
}
}
make 'grammar ' ~
($<title>.subst(/\W/, '', :g) || 'anonymous') ~
" \{\n rule TOP \{^[" ~ (join '|', @top ) ~
"]+\$\}\n " ~ $<ruleset>>>.ast ~ "\n\}"
}
method ruleset($/) {
make 'rule ' ~ $<name> ~ ' {' ~
$<expression>.ast ~ "\\h*}\n"
}
method expression($/) { make join '|', $<term>>>.ast }
method term($/) { make join '\h*', $<factor>>>.ast }
method factor($/) { make $<literal> ?? $<literal> !!
$<group> ?? '[' ~ $<group>.ast ~ ']' !!
$<repeat> ?? '[' ~ $<repeat>.ast ~ ']*' !!
$<optional> ?? '[' ~ $<optional>.ast ~ ']?' !!
'<' ~ $<identifier> ~ '>'
}
method repeat($/) { make $<expression>.ast }
method optional($/) { make $<expression>.ast }
method group($/) { make $<expression>.ast }
}
# Now test as follows
my @tests = (
{
ebnf =>
q<"a" {
a = "a1" ( "a2" | "a3" ) { "a4" } [ "a5" ] "a6" ;
} "z">
,
teststrings => [
'a1a3a4a4a5a6',
'a1 a2a6',
'a1 a3 a4 a6',
'a1 a4 a5 a6',
'a1 a2 a4 a5 a5 a6',
'a1 a2 a4 a5 a6 a7',
'your ad here'
]
},
{
ebnf =>
q<{
expr = term { plus term } .
term = factor { times factor } .
factor = number | '(' expr ')' .
plus = "+" | "-" .
times = "*" | "/" .
number = digit { digit } .
digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
}>
,
teststrings => [
'2',
'2*3 + 4/23 - 7',
'(3 + 4) * 6-2+(4*(4))',
'-2',
'3 +',
'(4 + 3'
]
},
{
ebnf => q<a = "1";>,
teststrings => ['foo']
},
{
ebnf => q<{ a = "1" ;>,
teststrings => ['foo']
},
{
ebnf => q<{ hello world = "1"; }>,
teststrings => ['foo']
},
{
ebnf => q<{ foo = bar . }>,
teststrings => ['foo']
},
);
my $i = 1;
for @tests -> $test {
my $a = EBNF::Actions;
unless EBNF.parse($test<ebnf>) {
say "Testing EBNF grammar:\n";
say "{$test<ebnf>.subst(/^|(\n)\h*/, -> $/ {$0}, :g)}\n";
say "Invalid EBNF grammar. Can not be parsed.";
say '*' x 60;
next;
}
my $p = EBNF.parse($test<ebnf>, :actions($a));
my $grammar = $p.ast;
$grammar ~~ m/^['grammar '](\w+)/;
my $title = $0.Str;
my $fn = 'EBNFtest'~$i++;
my $fh = open($fn, :w) or die "$!\n";
$fh.say( $grammar);
$fh.say( q|say "Testing EBNF grammar:\n";| );
$fh.say(qq|say q<{$test<ebnf>.subst(/^|(\n)\h*/,->$/{$0},:g)}>,"\n";|);
$fh.say( q|say "Parses as valid EBNF.";| );
$fh.say( q|say '-' x 60;| );
my $len = [max] $test<teststrings>.flat>>.chars;
for $test<teststrings>.flat -> $s {
$fh.say( qq|printf "%{$len}s is %svalid.\n", '{$s}',| ~
qq|{$title}.parse('{$s}') ?? '' !! 'NOT ';|);
}
$fh.close;
say qqx/perl6 $fn/;
say '*' x 60;
unlink $fn;
}</lang>
Output:
<pre>
Testing EBNF grammar:
"a" {
a = "a1" ( "a2" | "a3" ) { "a4" } [ "a5" ] "a6" ;
} "z"
Parses as valid EBNF.
------------------------------------------------------------
a1a3a4a4a5a6 is valid.
a1 a2a6 is valid.
a1 a3 a4 a6 is valid.
a1 a4 a5 a6 is NOT valid.
a1 a2 a4 a5 a5 a6 is NOT valid.
a1 a2 a4 a5 a6 a7 is NOT valid.
your ad here is NOT valid.
************************************************************
Testing EBNF grammar:
{
expr = term { plus term } .
term = factor { times factor } .
factor = number | '(' expr ')' .
plus = "+" | "-" .
times = "*" | "/" .
number = digit { digit } .
digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" .
}
Parses as valid EBNF.
------------------------------------------------------------
2 is valid.
2*3 + 4/23 - 7 is valid.
(3 + 4) * 6-2+(4*(4)) is valid.
-2 is NOT valid.
3 + is NOT valid.
(4 + 3 is NOT valid.
************************************************************
Testing EBNF grammar:
a = "1";
Invalid EBNF grammar. Can not be parsed.
************************************************************
Testing EBNF grammar:
{ a = "1" ;
Invalid EBNF grammar. Can not be parsed.
************************************************************
Testing EBNF grammar:
{ hello world = "1"; }
Invalid EBNF grammar. Can not be parsed.
************************************************************
Testing EBNF grammar:
{ foo = bar . }
Parses as valid EBNF.
------------------------------------------------------------
Method 'bar' not found for invocant of class 'anonymous'
in 'anonymous::foo' at line 3:EBNFtest3
in 'anonymous::TOP' at line 2:EBNFtest3
in 'Grammar::parse' at line 6466:src/gen/core.pm
in main program body at line 12:EBNFtest3
************************************************************
</pre>
=={{header|PicoLisp}}==
| |||