pidl/expr.yp

   1 # expr.yp
   2 # Copyright (C) 2006 Jelmer Vernooij <jelmer@samba.org>
   3 # Published under the GNU GPL
   4 #
   5 %left   '->'
   6 %right  '!' '~'
   7 %left   '*' '/' '%'
   8 %left   '+' '-'
   9 %left   '<<' '>>'
  10 %left   '>' '<'
  11 %left   '==' '!='
  12 %left   '&'
  13 %left   '|'
  14 %left   '&&'
  15 %left   '||'
  16 %left   '?' ':'
  17 %left   NEG DEREF ADDROF INV
  18 %left   '.'
  19
  20 %%
  21 exp:
  22         NUM
  23         |
  24         TEXT                { "\"$_[1]\"" }
  25         |
  26         func
  27         |
  28         var
  29         |
  30         '~' exp %prec INV   { "~$_[2]" }
  31         |
  32         exp '+' exp         { "$_[1] + $_[3]" }
  33         |
  34         exp '-' exp         { "$_[1] - $_[3]" }
  35         |
  36         exp '*' exp         { "$_[1] * $_[3]" }
  37         |
  38         exp '%' exp         { "$_[1] % $_[3]" }
  39         |
  40         exp '<' exp         { "$_[1] < $_[3]" }
  41         |
  42         exp '>' exp         { "$_[1] > $_[3]" }
  43         |
  44         exp '|' exp         { "$_[1] | $_[3]" }
  45         |
  46         exp '==' exp        { "$_[1] == $_[3]" }
  47         |
  48         exp '<=' exp        { "$_[1] <= $_[3]" }
  49         |
  50         exp '=>' exp        { "$_[1] => $_[3]" }
  51         |
  52         exp '<<' exp        { "$_[1] << $_[3]" }
  53         |
  54         exp '>>' exp        { "$_[1] >> $_[3]" }
  55         |
  56         exp '!=' exp        { "$_[1] != $_[3]" }
  57         |
  58         exp '||' exp        { "$_[1] || $_[3]" }
  59         |
  60         exp '&&' exp        { "$_[1] && $_[3]" }
  61         |
  62         exp '&' exp         { "$_[1] & $_[3]" }
  63         |
  64         exp '?' exp ':' exp { "$_[1]?$_[3]:$_[5]" }
  65         |
  66         '~' exp             { "~$_[1]" }
  67         |
  68         '!' exp             { "not $_[1]" }
  69         |
  70         exp '/' exp         { "$_[1] / $_[3]" }
  71         |
  72         '-' exp %prec NEG   { "-$_[2]" }
  73         |
  74         '&' exp %prec ADDROF { "&$_[2]" }
  75         |
  76         exp '^' exp         { "$_[1]^$_[3]" }
  77         |
  78         '(' exp ')'         { "($_[2])" }
  79 ;
  80
  81 possible_pointer:
  82         VAR                              { $_[0]->_Lookup($_[1]) }
  83         |
  84         '*' possible_pointer %prec DEREF { $_[0]->_Dereference($_[2]); "*$_[2]" }
  85 ;
  86
  87 var:
  88         possible_pointer    { $_[0]->_Use($_[1]) }
  89         |
  90         var '.' VAR         { $_[0]->_Use("$_[1].$_[3]") }
  91         |
  92         '(' var ')'         { "($_[2])" }
  93         |
  94         var '->' VAR        { $_[0]->_Use("*$_[1]"); $_[1]."->".$_[3] }
  95 ;
  96
  97
  98 func:
  99         VAR '(' opt_args ')' { "$_[1]($_[3])" }
 100 ;
 101
 102 opt_args:
 103         #empty
 104         { "" }
 105         |
 106         args
 107 ;
 108
 109 exp_or_possible_pointer:
 110         exp
 111         |
 112         possible_pointer
 113 ;
 114
 115 args:
 116         exp_or_possible_pointer
 117         |
 118         exp_or_possible_pointer ',' args { "$_[1], $_[3]" }
 119 ;
 120
 121 %%
 122
 123 package Parse::Pidl::Expr;
 124
 125 sub _Lexer {
 126         my($parser)=shift;
 127
 128         $parser->YYData->{INPUT}=~s/^[ \t]//;
 129
 130         for ($parser->YYData->{INPUT}) {
 131                 if (s/^(0x[0-9A-Fa-f]+)//) {
 132                         $parser->YYData->{LAST_TOKEN} = $1;
 133                         return('NUM',$1);
 134                 }
 135                 if (s/^([0-9]+(?:\.[0-9]+)?)//) {
 136                         $parser->YYData->{LAST_TOKEN} = $1;
 137                         return('NUM',$1);
 138                 }
 139                 if (s/^([A-Za-z_][A-Za-z0-9_]*)//) {
 140                         $parser->YYData->{LAST_TOKEN} = $1;
 141                         return('VAR',$1);
 142                 }
 143                 if (s/^\"(.*?)\"//) {
 144                         $parser->YYData->{LAST_TOKEN} = $1;
 145                         return('TEXT',$1);
 146                 }
 147                 if (s/^(==|!=|<=|>=|->|\|\||<<|>>|&&)//s) {
 148                         $parser->YYData->{LAST_TOKEN} = $1;
 149                         return($1,$1);
 150                 }
 151                 if (s/^(.)//s) {
 152                         $parser->YYData->{LAST_TOKEN} = $1;
 153                         return($1,$1);
 154                 }
 155         }
 156 }
 157
 158 sub _Use($$)
 159 {
 160         my ($self, $x) = @_;
 161         if (defined($self->YYData->{USE})) {
 162                 return $self->YYData->{USE}->($x);
 163         }
 164         return $x;
 165 }
 166
 167 sub _Lookup($$)
 168 {
 169         my ($self, $x) = @_;
 170         return $self->YYData->{LOOKUP}->($x);
 171 }
 172
 173 sub _Dereference($$)
 174 {
 175         my ($self, $x) = @_;
 176         if (defined($self->YYData->{DEREFERENCE})) {
 177                 $self->YYData->{DEREFERENCE}->($x);
 178         }
 179 }
 180
 181 sub _Error($)
 182 {
 183         my ($self) = @_;
 184         if (defined($self->YYData->{LAST_TOKEN})) {
 185                 $self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."' near `". $self->YYData->{LAST_TOKEN} . "'");
 186         } else {
 187                 $self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."'");
 188         }
 189 }
 190
 191 sub Run {
 192         my($self, $data, $error, $lookup, $deref, $use) = @_;
 193
 194         $self->YYData->{FULL_INPUT} = $data;
 195         $self->YYData->{INPUT} = $data;
 196         $self->YYData->{LOOKUP} = $lookup;
 197         $self->YYData->{DEREFERENCE} = $deref;
 198         $self->YYData->{ERROR} = $error;
 199         $self->YYData->{USE} = $use;
 200
 201         return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error);
 202 }