source/pidl/idl.yp

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