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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
# expr.yp
# Copyright (C) 2006 Jelmer Vernooij <jelmer@samba.org>
# Published under the GNU GPL
#
%left '->'
%right '!' '~'
%left '*' '/' '%'
%left '+' '-'
%left '<<' '>>'
%left '>' '<'
%left '==' '!='
%left '&'
%left '|'
%left '&&'
%left '||'
%left '?' ':'
%left NEG DEREF ADDROF INV
%left '.'
%%
exp: NUM
| TEXT { "\"$_[1]\"" }
| func
| exp '.' VAR { "$_[1].$_[3]" }
| VAR { $_[0]->_Lookup($_[1]) }
| '*' exp %prec DEREF { $_[0]->_Dereference($_[2]); "*$_[2]" }
| '~' exp %prec INV { "~$_[2]" }
| exp '+' exp { "$_[1] + $_[3]" }
| exp '-' exp { "$_[1] - $_[3]" }
| exp '*' exp { "$_[1] * $_[3]" }
| exp '%' exp { "$_[1] % $_[3]" }
| exp '<' exp { "$_[1] < $_[3]" }
| exp '>' exp { "$_[1] > $_[3]" }
| exp '|' exp { "$_[1] | $_[3]" }
| exp '==' exp { "$_[1] == $_[3]" }
| exp '<=' exp { "$_[1] <= $_[3]" }
| exp '=>' exp { "$_[1] => $_[3]" }
| exp '<<' exp { "$_[1] << $_[3]" }
| exp '>>' exp { "$_[1] >> $_[3]" }
| exp '!=' exp { "$_[1] != $_[3]" }
| exp '||' exp { "$_[1] || $_[3]" }
| exp '&&' exp { "$_[1] && $_[3]" }
| exp '&' exp { "$_[1] & $_[3]" }
| exp '->' VAR { $_[1]."->".$_[3] }
| exp '?' exp ':' exp { "$_[1]?$_[3]:$_[5]" }
| '~' exp { "~$_[1]" }
| '!' exp { "not $_[1]" }
| exp '/' exp { "$_[1] / $_[3]" }
| '-' exp %prec NEG { "-$_[2]" }
| '&' exp %prec ADDROF { "&$_[2]" }
| exp '^' exp { "$_[1]^$_[3]" }
| '(' exp ')' { "($_[2])" }
;
func: VAR '(' opt_args ')' { "$_[1]($_[3])" };
opt_args: { "" } | args;
args: exp | exp ',' args { "$_[1], $_[3]" };
%%
package Parse::Pidl::Expr;
sub _Lexer {
my($parser)=shift;
$parser->YYData->{INPUT}=~s/^[ \t]//;
for ($parser->YYData->{INPUT}) {
if (s/^(0x[0-9A-Fa-f]+)//) {
$parser->YYData->{LAST_TOKEN} = $1;
return('NUM',$1);
}
if (s/^([0-9]+(?:\.[0-9]+)?)//) {
$parser->YYData->{LAST_TOKEN} = $1;
return('NUM',$1);
}
if (s/^([A-Za-z_][A-Za-z0-9_]*)//) {
$parser->YYData->{LAST_TOKEN} = $1;
return('VAR',$1);
}
if (s/^\"(.*?)\"//) {
$parser->YYData->{LAST_TOKEN} = $1;
return('TEXT',$1);
}
if (s/^(==|!=|<=|>=|->|\|\||<<|>>|&&)//s) {
$parser->YYData->{LAST_TOKEN} = $1;
return($1,$1);
}
if (s/^(.)//s) {
$parser->YYData->{LAST_TOKEN} = $1;
return($1,$1);
}
}
}
sub _Lookup($$)
{
my ($self, $x) = @_;
return $self->YYData->{LOOKUP}->($x);
}
sub _Dereference($$)
{
my ($self, $x) = @_;
if (defined($self->YYData->{DEREFERENCE})) {
$self->YYData->{DEREFERENCE}->($x);
}
}
sub _Error($)
{
my ($self) = @_;
$self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."' near `". $self->YYData->{LAST_TOKEN} . "'");
}
sub Run {
my($self, $data, $error, $lookup, $deref) = @_;
$self->YYData->{FULL_INPUT} = $data;
$self->YYData->{INPUT} = $data;
$self->YYData->{LOOKUP} = $lookup;
$self->YYData->{DEREFERENCE} = $deref;
$self->YYData->{ERROR} = $error;
return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error);
}
|
