1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
%{
%}
%token NUMBER LITERAL NAME
%%
ruleset: rule { $main::start = $1; }
| ruleset rule
;
rule: NAME '=' blist ';' { $$ = $1;
$main::rules{$1} = $3; }
;
blist: branch { $$ = bless [$1], Rule; }
| blist '|' branch { $$ = $1; push (@{$$}, $3); }
;
branch: item { $$ = bless [$1], Branch; }
| branch item { $$ = $1; push (@{$$}, $2); }
;
item: LITERAL { $$ = new Literal($1); }
| NAME { $$ = new Name($1); }
;
%%
sub yylex
{
my ($s) = @_;
my ($c, $val);
AGAIN:
while (($c = $s->getc) eq ' ' || $c eq "\t" || $c eq "\n") { }
if ($c eq '') { return 0; }
# read a comment
elsif ($c eq '#') {
while (($c = $s->getc) ne '' && $c ne "\n") { }
$s->ungetc;
goto AGAIN;
}
# read a string literal
elsif ($c eq "\"") {
while (($c = $s->getc) ne '' && $c ne "\"") {
if ($c eq "\\") {
$c = $s->getc;
if ($c eq "\\") { $c = "\\"; }
elsif ($c eq "n") { $c = "\n"; }
elsif ($c eq "t") { $c = "\t"; }
elsif ($c eq "\"") { $c = "\""; }
}
$val .= $c;
}
return ($LITERAL, $val);
}
# read a rule name
elsif ($c =~ /[a-zA-Z_-]/) {
$val = $c;
while (($c = $s->getc) =~ /[a-zA-Z0-9_-]/) {
$val .= $c;
}
$s->ungetc;
return ($NAME, $val);
}
else {
return ord($c);
}
}
sub yyerror {
my ($msg, $s) = @_;
die "$msg at " . $s->name . " line " . $s->lineno . ".\n";
}
|
