source4/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 grammar, but
   9 # by providing a precedence we reduce the number of conflicts
  10 # enormously
  11 %left   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
  12
  13
  14 ################
  15 # grammar
  16 %%
  17 idl:
  18         #empty  { {} }
  19         | idl interface { push(@{$_[1]}, $_[2]); $_[1] }
  20         | idl coclass { push(@{$_[1]}, $_[2]); $_[1] }
  21         | idl import { push(@{$_[1]}, $_[2]); $_[1] }
  22         | idl include { push(@{$_[1]}, $_[2]); $_[1] }
  23         | idl importlib { push(@{$_[1]}, $_[2]); $_[1] }
  24 ;
  25
  26 import: 'import' commalist ';' {{
  27                         "TYPE" => "IMPORT",
  28                         "PATHS" => $_[2],
  29                    "FILE" => $_[0]->YYData->{FILE},
  30                    "LINE" => $_[0]->YYData->{LINE}
  31                 }}
  32 ;
  33 include: 'include' commalist ';' {{
  34                         "TYPE" => "INCLUDE",
  35                         "PATHS" => $_[2],
  36                    "FILE" => $_[0]->YYData->{FILE},
  37                    "LINE" => $_[0]->YYData->{LINE}
  38                 }}
  39 ;
  40 importlib: 'importlib' commalist ';' {{
  41                         "TYPE" => "IMPORTLIB",
  42                         "PATHS" => $_[2],
  43                    "FILE" => $_[0]->YYData->{FILE},
  44                    "LINE" => $_[0]->YYData->{LINE}
  45                 }}
  46 ;
  47
  48 commalist:
  49       text { [ $_[1] ] }
  50     | commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] }
  51 ;
  52
  53 coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
  54           {{
  55                "TYPE" => "COCLASS",
  56                "PROPERTIES" => $_[1],
  57                "NAME" => $_[3],
  58                "DATA" => $_[5],
  59                    "FILE" => $_[0]->YYData->{FILE},
  60                    "LINE" => $_[0]->YYData->{LINE},
  61           }}
  62 ;
  63
  64 interface_names:
  65         #empty { {} }
  66         | interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
  67 ;
  68
  69 interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
  70           {{
  71                "TYPE" => "INTERFACE",
  72                "PROPERTIES" => $_[1],
  73                "NAME" => $_[3],
  74                "BASE" => $_[4],
  75                "DATA" => $_[6],
  76                    "FILE" => $_[0]->YYData->{FILE},
  77                    "LINE" => $_[0]->YYData->{LINE},
  78           }}
  79 ;
  80
  81 base_interface:
  82         #empty
  83         | ':' identifier { $_[2] }
  84 ;
  85
  86 definitions:
  87       definition              { [ $_[1] ] }
  88     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
  89 ;
  90
  91
  92 definition: function | const | typedef | declare | typedecl
  93 ;
  94
  95 const: 'const' identifier pointers identifier '=' anytext ';'
  96         {{
  97                      "TYPE"  => "CONST",
  98                      "DTYPE"  => $_[2],
  99                          "POINTERS" => $_[3],
 100                      "NAME"  => $_[4],
 101                      "VALUE" => $_[6],
 102                      "FILE" => $_[0]->YYData->{FILE},
 103                      "LINE" => $_[0]->YYData->{LINE},
 104         }}
 105         | 'const' identifier pointers identifier array_len '=' anytext ';'
 106         {{
 107                      "TYPE"  => "CONST",
 108                      "DTYPE"  => $_[2],
 109                          "POINTERS" => $_[3],
 110                      "NAME"  => $_[4],
 111                      "ARRAY_LEN" => $_[5],
 112                      "VALUE" => $_[7],
 113                      "FILE" => $_[0]->YYData->{FILE},
 114                      "LINE" => $_[0]->YYData->{LINE},
 115         }}
 116 ;
 117
 118
 119 function: property_list type identifier '(' element_list2 ')' ';'
 120          {{
 121                 "TYPE" => "FUNCTION",
 122                 "NAME" => $_[3],
 123                 "RETURN_TYPE" => $_[2],
 124                 "PROPERTIES" => $_[1],
 125                 "ELEMENTS" => $_[5],
 126                 "FILE" => $_[0]->YYData->{FILE},
 127                 "LINE" => $_[0]->YYData->{LINE},
 128           }}
 129 ;
 130
 131 declare: 'declare' property_list decl_type identifier';'
 132         {{
 133                      "TYPE" => "DECLARE",
 134                      "PROPERTIES" => $_[2],
 135                      "NAME" => $_[4],
 136                      "DATA" => $_[3],
 137                      "FILE" => $_[0]->YYData->{FILE},
 138                      "LINE" => $_[0]->YYData->{LINE},
 139         }}
 140 ;
 141
 142 decl_type: decl_enum | decl_bitmap | decl_union
 143 ;
 144
 145 decl_enum: 'enum'
 146         {{
 147                      "TYPE" => "ENUM"
 148         }}
 149 ;
 150
 151 decl_bitmap: 'bitmap'
 152         {{
 153                      "TYPE" => "BITMAP"
 154         }}
 155 ;
 156
 157 decl_union: 'union'
 158         {{
 159                      "TYPE" => "UNION"
 160         }}
 161 ;
 162
 163 typedef: 'typedef' property_list type identifier array_len ';'
 164         {{
 165                      "TYPE" => "TYPEDEF",
 166                      "PROPERTIES" => $_[2],
 167                      "NAME" => $_[4],
 168                      "DATA" => $_[3],
 169                      "ARRAY_LEN" => $_[5],
 170                      "FILE" => $_[0]->YYData->{FILE},
 171                      "LINE" => $_[0]->YYData->{LINE},
 172         }}
 173 ;
 174
 175 usertype: struct | union | enum | bitmap;
 176
 177 typedecl: usertype ';' { $_[1] };
 178
 179 sign: 'signed' | 'unsigned';
 180
 181 existingtype:
 182         sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" }
 183         | identifier
 184 ;
 185
 186 type: usertype | existingtype | void { "void" } ;
 187
 188 enum_body: '{' enum_elements '}' { $_[2] };
 189 opt_enum_body: | enum_body;
 190 enum: 'enum' optional_identifier opt_enum_body
 191         {{
 192              "TYPE" => "ENUM",
 193                          "NAME" => $_[2],
 194                      "ELEMENTS" => $_[3]
 195         }}
 196 ;
 197
 198 enum_elements:
 199       enum_element                    { [ $_[1] ] }
 200     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
 201 ;
 202
 203 enum_element: identifier
 204               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
 205 ;
 206
 207 bitmap_body: '{' opt_bitmap_elements '}' { $_[2] };
 208 opt_bitmap_body: | bitmap_body;
 209 bitmap: 'bitmap' optional_identifier opt_bitmap_body
 210         {{
 211              "TYPE" => "BITMAP",
 212                          "NAME" => $_[2],
 213                      "ELEMENTS" => $_[3]
 214         }}
 215 ;
 216
 217 bitmap_elements:
 218       bitmap_element                    { [ $_[1] ] }
 219     | bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
 220 ;
 221
 222 opt_bitmap_elements: | bitmap_elements;
 223
 224 bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
 225 ;
 226
 227 struct_body: '{' element_list1 '}' { $_[2] };
 228 opt_struct_body: | struct_body;
 229
 230 struct: 'struct' optional_identifier opt_struct_body
 231         {{
 232              "TYPE" => "STRUCT",
 233                          "NAME" => $_[2],
 234                      "ELEMENTS" => $_[3]
 235         }}
 236 ;
 237
 238 empty_element: property_list ';'
 239         {{
 240                  "NAME" => "",
 241                  "TYPE" => "EMPTY",
 242                  "PROPERTIES" => $_[1],
 243                  "POINTERS" => 0,
 244                  "ARRAY_LEN" => [],
 245                  "FILE" => $_[0]->YYData->{FILE},
 246                  "LINE" => $_[0]->YYData->{LINE},
 247          }}
 248 ;
 249
 250 base_or_empty: base_element ';' | empty_element;
 251
 252 optional_base_element:
 253         property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
 254 ;
 255
 256 union_elements:
 257     #empty
 258     | union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
 259 ;
 260
 261 union_body: '{' union_elements '}' { $_[2] };
 262 opt_union_body: | union_body;
 263
 264 union: 'union' optional_identifier opt_union_body
 265         {{
 266              "TYPE" => "UNION",
 267                      "NAME" => $_[2],
 268                      "ELEMENTS" => $_[3]
 269         }}
 270 ;
 271
 272 base_element: property_list type pointers identifier array_len
 273               {{
 274                            "NAME" => $_[4],
 275                            "TYPE" => $_[2],
 276                            "PROPERTIES" => $_[1],
 277                            "POINTERS" => $_[3],
 278                            "ARRAY_LEN" => $_[5],
 279                        "FILE" => $_[0]->YYData->{FILE},
 280                        "LINE" => $_[0]->YYData->{LINE},
 281               }}
 282 ;
 283
 284
 285 pointers:
 286   #empty
 287    { 0 }
 288     | pointers '*'  { $_[1]+1 }
 289 ;
 290
 291 element_list1:
 292     #empty
 293     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
 294 ;
 295
 296 element_list2:
 297     #empty
 298     | 'void'
 299     | base_element { [ $_[1] ] }
 300     | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[1] }
 301 ;
 302
 303 array_len:
 304     #empty                        { [] }
 305     | '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
 306     | '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
 307 ;
 308
 309
 310 property_list:
 311     #empty
 312     | property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
 313 ;
 314
 315 properties: property          { $_[1] }
 316     | properties ',' property { FlattenHash([$_[1], $_[3]]); }
 317 ;
 318
 319 property: identifier                   {{ "$_[1]" => "1"     }}
 320           | identifier '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
 321 ;
 322
 323 listtext:
 324     anytext
 325     | listtext ',' anytext { "$_[1] $_[3]" }
 326 ;
 327
 328 commalisttext:
 329     anytext
 330     | commalisttext ',' anytext { "$_[1],$_[3]" }
 331 ;
 332
 333 anytext:  #empty
 334     { "" }
 335     | identifier | constant | text
 336     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
 337     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
 338     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
 339     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
 340     | anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
 341     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
 342     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
 343     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
 344     | anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
 345     | anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
 346     | anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
 347     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
 348     | anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
 349     | anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
 350     | anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
 351 ;
 352
 353 identifier: IDENTIFIER
 354 ;
 355
 356 optional_identifier:
 357         IDENTIFIER
 358    | #empty { undef }
 359 ;
 360
 361 constant: CONSTANT
 362 ;
 363
 364 text: TEXT { "\"$_[1]\"" }
 365 ;
 366
 367 optional_semicolon:
 368         #empty
 369         | ';'
 370 ;
 371
 372
 373 #####################################
 374 # start code
 375 %%
 376
 377 use Parse::Pidl qw(error);
 378
 379 #####################################################################
 380 # flatten an array of hashes into a single hash
 381 sub FlattenHash($)
 382 {
 383     my $a = shift;
 384     my %b;
 385     for my $d (@{$a}) {
 386         for my $k (keys %{$d}) {
 387             $b{$k} = $d->{$k};
 388         }
 389     }
 390     return \%b;
 391 }
 392
 393
 394
 395 #####################################################################
 396 # traverse a perl data structure removing any empty arrays or
 397 # hashes and any hash elements that map to undef
 398 sub CleanData($)
 399 {
 400     sub CleanData($);
 401     my($v) = shift;
 402         return undef if (not defined($v));
 403     if (ref($v) eq "ARRAY") {
 404         foreach my $i (0 .. $#{$v}) {
 405             CleanData($v->[$i]);
 406             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) {
 407                     $v->[$i] = undef;
 408                     next;
 409             }
 410         }
 411         # this removes any undefined elements from the array
 412         @{$v} = grep { defined $_ } @{$v};
 413     } elsif (ref($v) eq "HASH") {
 414         foreach my $x (keys %{$v}) {
 415             CleanData($v->{$x});
 416             if (!defined $v->{$x}) { delete($v->{$x}); next; }
 417             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
 418         }
 419     }
 420         return $v;
 421 }
 422
 423 sub _Error {
 424     if (exists $_[0]->YYData->{ERRMSG}) {
 425                 error($_[0]->YYData, $_[0]->YYData->{ERRMSG});
 426                 delete $_[0]->YYData->{ERRMSG};
 427                 return;
 428         };
 429         my $last_token = $_[0]->YYData->{LAST_TOKEN};
 430
 431         error($_[0]->YYData, "Syntax error near '$last_token'");
 432 }
 433
 434 sub _Lexer($)
 435 {
 436         my($parser)=shift;
 437
 438     $parser->YYData->{INPUT} or return('',undef);
 439
 440 again:
 441         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
 442
 443         for ($parser->YYData->{INPUT}) {
 444                 if (/^\#/) {
 445                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
 446                                 $parser->YYData->{LINE} = $1-1;
 447                                 $parser->YYData->{FILE} = $2;
 448                                 goto again;
 449                         }
 450                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
 451                                 $parser->YYData->{LINE} = $1-1;
 452                                 $parser->YYData->{FILE} = $2;
 453                                 goto again;
 454                         }
 455                         if (s/^(\#.*)$//m) {
 456                                 goto again;
 457                         }
 458                 }
 459                 if (s/^(\n)//) {
 460                         $parser->YYData->{LINE}++;
 461                         goto again;
 462                 }
 463                 if (s/^\"(.*?)\"//) {
 464                         $parser->YYData->{LAST_TOKEN} = $1;
 465                         return('TEXT',$1);
 466                 }
 467                 if (s/^(\d+)(\W|$)/$2/) {
 468                         $parser->YYData->{LAST_TOKEN} = $1;
 469                         return('CONSTANT',$1);
 470                 }
 471                 if (s/^([\w_]+)//) {
 472                         $parser->YYData->{LAST_TOKEN} = $1;
 473                         if ($1 =~
 474                             /^(coclass|interface|const|typedef|declare|union
 475                               |struct|enum|bitmap|void|unsigned|signed|import|include
 476                                   |importlib)$/x) {
 477                                 return $1;
 478                         }
 479                         return('IDENTIFIER',$1);
 480                 }
 481                 if (s/^(.)//s) {
 482                         $parser->YYData->{LAST_TOKEN} = $1;
 483                         return($1,$1);
 484                 }
 485         }
 486 }
 487
 488 sub parse_string
 489 {
 490         my ($data,$filename) = @_;
 491
 492         my $self = new Parse::Pidl::IDL;
 493
 494     $self->YYData->{FILE} = $filename;
 495     $self->YYData->{INPUT} = $data;
 496     $self->YYData->{LINE} = 0;
 497     $self->YYData->{LAST_TOKEN} = "NONE";
 498
 499         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
 500
 501         return CleanData($idl);
 502 }
 503
 504 sub parse_file($$)
 505 {
 506         my ($filename,$incdirs) = @_;
 507
 508         my $saved_delim = $/;
 509         undef $/;
 510         my $cpp = $ENV{CPP};
 511         if (! defined $cpp) {
 512                 $cpp = "cpp";
 513         }
 514         my $includes = join('',map { " -I$_" } @$incdirs);
 515         my $data = `$cpp -D__PIDL__$includes -xc $filename`;
 516         $/ = $saved_delim;
 517
 518         return parse_string($data, $filename);
 519 }