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:        NUM
  22                 |       TEXT                            { "\"$_[1]\"" }
  23                 |       func
  24                 |   var
  25         |   '~' exp %prec INV   { "~$_[2]" }
  26         |   exp '+' exp         { "$_[1] + $_[3]" }
  27         |   exp '-' exp         { "$_[1] - $_[3]" }
  28         |   exp '*' exp         { "$_[1] * $_[3]" }
  29         |   exp '%' exp         { "$_[1] % $_[3]" }
  30         |   exp '<' exp         { "$_[1] < $_[3]" }
  31         |   exp '>' exp         { "$_[1] > $_[3]" }
  32         |   exp '|' exp         { "$_[1] | $_[3]" }
  33         |   exp '==' exp         { "$_[1] == $_[3]" }
  34         |   exp '<=' exp         { "$_[1] <= $_[3]" }
  35         |   exp '=>' exp         { "$_[1] => $_[3]" }
  36         |   exp '<<' exp         { "$_[1] << $_[3]" }
  37         |   exp '>>' exp         { "$_[1] >> $_[3]" }
  38         |   exp '!=' exp         { "$_[1] != $_[3]" }
  39         |   exp '||' exp        { "$_[1] || $_[3]" }
  40         |   exp '&&' exp        { "$_[1] && $_[3]" }
  41         |   exp '&' exp         { "$_[1] & $_[3]" }
  42                 |       exp '?' exp ':' exp { "$_[1]?$_[3]:$_[5]" }
  43                 |       '~' exp                         { "~$_[1]" }
  44                 |       '!' exp                         { "not $_[1]" }
  45         |   exp '/' exp         { "$_[1] / $_[3]" }
  46         |   '-' exp %prec NEG   { "-$_[2]" }
  47         |   '&' exp %prec ADDROF { "&$_[2]" }
  48         |   exp '^' exp         { "$_[1]^$_[3]" }
  49         |   '(' exp ')'         { "($_[2])" }
  50 ;
  51
  52 possible_pointer:
  53             VAR                 { $_[0]->_Lookup($_[1]) }
  54         |   '*' possible_pointer %prec DEREF { $_[0]->_Dereference($_[2]); "*$_[2]" }
  55                 ;
  56
  57 var:    possible_pointer        { $_[0]->_Use($_[1]) }
  58                 |       var '.' VAR                     { $_[0]->_Use("$_[1].$_[3]") }
  59                 |   '(' var ')'         { "($_[2])" }
  60                 |       var '->' VAR            { $_[0]->_Use("*$_[1]"); $_[1]."->".$_[3] }
  61 ;
  62
  63
  64 func: VAR '(' opt_args ')' { "$_[1]($_[3])" };
  65 opt_args: { "" } | args;
  66 exp_or_possible_pointer: exp | possible_pointer;
  67 args: exp_or_possible_pointer
  68     | exp_or_possible_pointer ',' args { "$_[1], $_[3]" }
  69 ;
  70
  71 %%
  72
  73 package Parse::Pidl::Expr;
  74
  75 sub _Lexer {
  76     my($parser)=shift;
  77
  78     $parser->YYData->{INPUT}=~s/^[ \t]//;
  79
  80     for ($parser->YYData->{INPUT}) {
  81         if (s/^(0x[0-9A-Fa-f]+)//) {
  82                         $parser->YYData->{LAST_TOKEN} = $1;
  83             return('NUM',$1);
  84                 }
  85         if (s/^([0-9]+(?:\.[0-9]+)?)//) {
  86                         $parser->YYData->{LAST_TOKEN} = $1;
  87             return('NUM',$1);
  88                 }
  89         if (s/^([A-Za-z_][A-Za-z0-9_]*)//) {
  90                         $parser->YYData->{LAST_TOKEN} = $1;
  91                 return('VAR',$1);
  92                 }
  93                 if (s/^\"(.*?)\"//) {
  94                         $parser->YYData->{LAST_TOKEN} = $1;
  95                         return('TEXT',$1);
  96                 }
  97                 if (s/^(==|!=|<=|>=|->|\|\||<<|>>|&&)//s) {
  98                         $parser->YYData->{LAST_TOKEN} = $1;
  99             return($1,$1);
 100                 }
 101         if (s/^(.)//s) {
 102                         $parser->YYData->{LAST_TOKEN} = $1;
 103             return($1,$1);
 104                 }
 105     }
 106 }
 107
 108 sub _Use($$)
 109 {
 110         my ($self, $x) = @_;
 111         if (defined($self->YYData->{USE})) {
 112                 return $self->YYData->{USE}->($x);
 113         }
 114         return $x;
 115 }
 116
 117 sub _Lookup($$)
 118 {
 119         my ($self, $x) = @_;
 120         return $self->YYData->{LOOKUP}->($x);
 121 }
 122
 123 sub _Dereference($$)
 124 {
 125         my ($self, $x) = @_;
 126         if (defined($self->YYData->{DEREFERENCE})) {
 127                 $self->YYData->{DEREFERENCE}->($x);
 128         }
 129 }
 130
 131 sub _Error($)
 132 {
 133         my ($self) = @_;
 134         if (defined($self->YYData->{LAST_TOKEN})) {
 135                 $self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."' near `". $self->YYData->{LAST_TOKEN} . "'");
 136         } else {
 137                 $self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."'");
 138         }
 139 }
 140
 141 sub Run {
 142     my($self, $data, $error, $lookup, $deref, $use) = @_;
 143     $self->YYData->{FULL_INPUT} = $data;
 144     $self->YYData->{INPUT} = $data;
 145     $self->YYData->{LOOKUP} = $lookup;
 146     $self->YYData->{DEREFERENCE} = $deref;
 147     $self->YYData->{ERROR} = $error;
 148     $self->YYData->{USE} = $use;
 149     return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error);
 150 }