source/build/pidl/idl.yp

   1 ########################
   2 # IDL Parse::Yapp parser
   3 # Copyright (C) Andrew Tridgell <tridge@samba.org>
   4 # released under the GNU GPL version 2 or later
   5
   6
   7
   8 # the precedence actually doesn't matter at all for this grammer, but
   9 # by providing a precedence we reduce the number of conflicts
  10 # enormously
  11 %left   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
  12
  13
  14 ################
  15 # grammer
  16 %%
  17 idl:
  18         #empty  { {} }
  19     | idl interface {
  20                 push(@{$_[1]}, $_[2]); $_[1]
  21         }
  22 ;
  23
  24 interface: property_list 'interface' identifier base_interface '{' definitions '}'
  25           {$_[3] => {
  26                "TYPE" => "INTERFACE",
  27                            "PROPERTIES" => $_[1],
  28                        "NAME" => $_[3],
  29                            "BASE" => $_[4],
  30                        "DATA" => $_[6],
  31           }}
  32 ;
  33
  34 base_interface:
  35         #empty
  36         | ':' identifier { $_[2] }
  37 ;
  38
  39 definitions:
  40       definition              { [ $_[1] ] }
  41     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
  42 ;
  43
  44
  45 definition: function | const | typedef
  46 ;
  47
  48 const: 'const' identifier identifier '=' anytext ';'
  49         {{
  50                      "TYPE"  => "CONST",
  51                      "DTYPE"  => $_[2],
  52                      "NAME"  => $_[3],
  53                      "VALUE" => $_[5]
  54         }}
  55 ;
  56
  57
  58 function: property_list type identifier '(' element_list2 ')' ';'
  59          {{
  60                 "TYPE" => "FUNCTION",
  61                 "NAME" => $_[3],
  62                 "RETURN_TYPE" => $_[2],
  63                 "PROPERTIES" => $_[1],
  64                 "DATA" => $_[5]
  65          }}
  66 ;
  67
  68 typedef: 'typedef' type identifier array_len ';'
  69         {{
  70                      "TYPE" => "TYPEDEF",
  71                      "NAME" => $_[3],
  72                      "DATA" => $_[2],
  73                      "ARRAY_LEN" => $_[4]
  74         }}
  75 ;
  76
  77 type:   struct | union | enum | identifier
  78         | void { "void" }
  79 ;
  80
  81
  82 enum: 'enum' '{' enum_elements '}'
  83         {{
  84                      "TYPE" => "ENUM",
  85                      "ELEMENTS" => $_[3]
  86         }}
  87 ;
  88
  89 enum_elements:
  90       enum_element                    { [ $_[1] ] }
  91     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
  92 ;
  93
  94 enum_element: identifier
  95               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
  96 ;
  97
  98 struct: property_list 'struct' '{' element_list1 '}'
  99         {{
 100                      "TYPE" => "STRUCT",
 101                      "PROPERTIES" => $_[1],
 102                      "ELEMENTS" => $_[4]
 103         }}
 104 ;
 105
 106 union: property_list 'union' '{' union_elements '}'
 107          {{
 108                 "TYPE" => "UNION",
 109                 "PROPERTIES" => $_[1],
 110                 "DATA" => $_[4]
 111          }}
 112 ;
 113
 114 union_elements:
 115       union_element                    { [ $_[1] ] }
 116     | union_elements union_element  { push(@{$_[1]}, $_[2]); $_[1] }
 117 ;
 118
 119 union_element:
 120          '[' 'case' '(' anytext ')' ']' base_element ';'
 121          {{
 122                 "TYPE" => "UNION_ELEMENT",
 123                 "CASE" => $_[4],
 124                 "DATA" => $_[7]
 125          }}
 126          | '[' 'case' '(' anytext ')' ']' ';'
 127          {{
 128                 "TYPE" => "EMPTY",
 129                 "CASE" => $_[4],
 130          }}
 131          | '[' 'default' ']' base_element ';'
 132          {{
 133                 "TYPE" => "UNION_ELEMENT",
 134                 "CASE" => "default",
 135                 "DATA" => $_[4]
 136          }}
 137          | '[' 'default' ']' ';'
 138          {{
 139                 "TYPE" => "EMPTY",
 140                 "CASE" => "default",
 141          }}
 142 ;
 143
 144 base_element: property_list type pointers identifier array_len
 145               {{
 146                            "NAME" => $_[4],
 147                            "TYPE" => $_[2],
 148                            "PROPERTIES" => $_[1],
 149                            "POINTERS" => $_[3],
 150                            "ARRAY_LEN" => $_[5]
 151               }}
 152 ;
 153
 154
 155 pointers:
 156   #empty
 157    { 0 }
 158     | pointers '*'  { $_[1]+1 }
 159 ;
 160
 161
 162
 163 element_list1:
 164     #empty
 165     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
 166 ;
 167
 168 element_list2:
 169     #empty
 170     | 'void'
 171     | base_element { [ $_[1] ] }
 172     | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[1] }
 173 ;
 174
 175 array_len:
 176     #empty
 177     | '[' ']'            { "*" }
 178     | '[' anytext ']'    { "$_[2]" }
 179 ;
 180
 181
 182 property_list:
 183     #empty
 184     | property_list '[' properties ']' { util::FlattenHash([$_[1],$_[3]]); }
 185 ;
 186
 187 properties: property          { $_[1] }
 188     | properties ',' property { util::FlattenHash([$_[1], $_[3]]); }
 189 ;
 190
 191 property: identifier                   {{ "$_[1]" => "1"     }}
 192           | identifier '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
 193 ;
 194
 195 listtext:
 196     anytext
 197     | listtext ',' anytext { "$_[1] $_[3]" }
 198 ;
 199
 200 anytext:  #empty
 201     { "" }
 202     | identifier | constant | text
 203     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
 204     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
 205     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
 206     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
 207     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
 208     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
 209     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
 210     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
 211     | anytext '(' anytext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
 212 ;
 213
 214 identifier: IDENTIFIER
 215 ;
 216
 217 constant: CONSTANT
 218 ;
 219
 220 text: TEXT { "\"$_[1]\"" }
 221 ;
 222
 223
 224 #####################################
 225 # start code
 226 %%
 227
 228 use util;
 229
 230 sub _Error {
 231         if (exists $_[0]->YYData->{ERRMSG}) {
 232                 print $_[0]->YYData->{ERRMSG};
 233                 delete $_[0]->YYData->{ERRMSG};
 234                 return;
 235         };
 236         my $line = $_[0]->YYData->{LINE};
 237         my $last_token = $_[0]->YYData->{LAST_TOKEN};
 238         my $file = $_[0]->YYData->{INPUT_FILENAME};
 239
 240         print "$file:$line: Syntax error near '$last_token'\n";
 241 }
 242
 243 sub _Lexer($)
 244 {
 245         my($parser)=shift;
 246
 247         $parser->YYData->{INPUT}
 248         or  return('',undef);
 249
 250 again:
 251         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
 252
 253         for ($parser->YYData->{INPUT}) {
 254                 if (/^\#/) {
 255                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
 256                                 $parser->YYData->{LINE} = $1-1;
 257                                 $parser->YYData->{INPUT_FILENAME} = $2;
 258                                 goto again;
 259                         }
 260                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
 261                                 $parser->YYData->{LINE} = $1-1;
 262                                 $parser->YYData->{INPUT_FILENAME} = $2;
 263                                 goto again;
 264                         }
 265                         if (s/^(\#.*)$//m) {
 266                                 goto again;
 267                         }
 268                 }
 269                 if (s/^(\n)//) {
 270                         $parser->YYData->{LINE}++;
 271                         goto again;
 272                 }
 273                 if (s/^\"(.*?)\"//) {
 274                         $parser->YYData->{LAST_TOKEN} = $1;
 275                         return('TEXT',$1);
 276                 }
 277                 if (s/^(\d+)(\W|$)/$2/) {
 278                         $parser->YYData->{LAST_TOKEN} = $1;
 279                         return('CONSTANT',$1);
 280                 }
 281                 if (s/^([\w_]+)//) {
 282                         $parser->YYData->{LAST_TOKEN} = $1;
 283                         if ($1 =~
 284                             /^(interface|const|typedef|union
 285                               |struct|enum|void|case|default)$/x) {
 286                                 return $1;
 287                         }
 288                         return('IDENTIFIER',$1);
 289                 }
 290                 if (s/^(.)//s) {
 291                         $parser->YYData->{LAST_TOKEN} = $1;
 292                         return($1,$1);
 293                 }
 294         }
 295 }
 296
 297 sub parse_idl($$)
 298 {
 299         my $self = shift;
 300         my $filename = shift;
 301
 302         my $saved_delim = $/;
 303         undef $/;
 304         my $cpp = $ENV{CPP};
 305         if (! defined $cpp) {
 306                 $cpp = "cpp"
 307         }
 308         my $data = `$cpp -xc $filename`;
 309         $/ = $saved_delim;
 310
 311     $self->YYData->{INPUT} = $data;
 312     $self->YYData->{LINE} = 0;
 313     $self->YYData->{LAST_TOKEN} = "NONE";
 314
 315         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
 316
 317         foreach my $x (@{$idl}) {
 318                 # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
 319                 # for 'object' interfaces
 320                 if (defined($x->{PROPERTIES}->{object})) {
 321                         foreach my $e (@{$x->{DATA}}) {
 322                                 if($e->{TYPE} eq "FUNCTION") {
 323                                         unshift(@{$e->{DATA}},
 324                         { 'NAME' => 'ORPCthis',
 325                           'POINTERS' => 1,
 326                           'PROPERTIES' => { 'in' => '1' },
 327                           'TYPE' => 'ORPCTHIS'
 328                         });
 329                                         unshift(@{$e->{DATA}},
 330                         { 'NAME' => 'ORPCthat',
 331                           'POINTERS' => 1,
 332                           'PROPERTIES' => { 'out' => '1' },
 333                                                   'TYPE' => 'ORPCTHAT'
 334                         });
 335                                 }
 336                         }
 337                 }
 338
 339                 # Do the inheritance
 340                 if (defined($x->{BASE}) and $x->{BASE} ne "") {
 341                         my $parent = util::get_interface($idl, $x->{BASE});
 342
 343                         if(not defined($parent)) {
 344                                 die("No such parent interface " . $x->{BASE});
 345                         }
 346
 347                         @{$x->{INHERITED_DATA}} = (@{$parent->{INHERITED_DATA}}, @{$x->{DATA}});
 348                 } else {
 349                         $x->{INHERITED_DATA} = $x->{DATA};
 350                 }
 351         }
 352
 353         return $idl;
 354 }