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