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         pipe
 194 ;
 195
 196 typedecl:
 197         usertype ';' { $_[1] }
 198 ;
 199
 200 sign:
 201         'signed'
 202         |
 203         'unsigned'
 204 ;
 205
 206 existingtype:
 207         sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" }
 208         |
 209         identifier
 210 ;
 211
 212 type:
 213         usertype
 214         |
 215         existingtype
 216         |
 217         void { "void" }
 218 ;
 219
 220 enum_body:
 221         '{' enum_elements '}' { $_[2] }
 222 ;
 223
 224 opt_enum_body:
 225         #empty
 226         |
 227         enum_body
 228 ;
 229
 230 enum:
 231         property_list 'enum' optional_identifier opt_enum_body
 232         {{
 233                 "TYPE" => "ENUM",
 234                 "PROPERTIES" => $_[1],
 235                 "NAME" => $_[3],
 236                 "ELEMENTS" => $_[4],
 237                 "FILE" => $_[0]->YYData->{FILE},
 238                 "LINE" => $_[0]->YYData->{LINE},
 239         }}
 240 ;
 241
 242 enum_elements:
 243         enum_element                    { [ $_[1] ] }
 244         |
 245         enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
 246 ;
 247
 248 enum_element:
 249         identifier
 250         |
 251         identifier '=' anytext { "$_[1]$_[2]$_[3]" }
 252 ;
 253
 254 bitmap_body:
 255         '{' opt_bitmap_elements '}' { $_[2] }
 256 ;
 257
 258 opt_bitmap_body:
 259         #empty
 260         |
 261         bitmap_body
 262 ;
 263
 264 bitmap:
 265         property_list 'bitmap' optional_identifier opt_bitmap_body
 266         {{
 267                 "TYPE" => "BITMAP",
 268                 "PROPERTIES" => $_[1],
 269                 "NAME" => $_[3],
 270                 "ELEMENTS" => $_[4],
 271                 "FILE" => $_[0]->YYData->{FILE},
 272                 "LINE" => $_[0]->YYData->{LINE},
 273         }}
 274 ;
 275
 276 bitmap_elements:
 277         bitmap_element                      { [ $_[1] ] }
 278         |
 279         bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
 280 ;
 281
 282 opt_bitmap_elements:
 283         #empty
 284         |
 285         bitmap_elements
 286 ;
 287
 288 bitmap_element:
 289         identifier '=' anytext { "$_[1] ( $_[3] )" }
 290 ;
 291
 292 struct_body:
 293         '{' element_list1 '}' { $_[2] }
 294 ;
 295
 296 opt_struct_body:
 297         #empty
 298         |
 299         struct_body
 300 ;
 301
 302 struct:
 303         property_list 'struct' optional_identifier opt_struct_body
 304         {{
 305                 "TYPE" => "STRUCT",
 306                 "PROPERTIES" => $_[1],
 307                 "NAME" => $_[3],
 308                 "ELEMENTS" => $_[4],
 309                 "FILE" => $_[0]->YYData->{FILE},
 310                 "LINE" => $_[0]->YYData->{LINE},
 311         }}
 312 ;
 313
 314 empty_element:
 315         property_list ';'
 316         {{
 317                 "NAME" => "",
 318                 "TYPE" => "EMPTY",
 319                 "PROPERTIES" => $_[1],
 320                 "POINTERS" => 0,
 321                 "ARRAY_LEN" => [],
 322                 "FILE" => $_[0]->YYData->{FILE},
 323                 "LINE" => $_[0]->YYData->{LINE},
 324         }}
 325 ;
 326
 327 base_or_empty:
 328         base_element ';'
 329         |
 330         empty_element;
 331
 332 optional_base_element:
 333         property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
 334 ;
 335
 336 union_elements:
 337         #empty
 338         |
 339         union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
 340 ;
 341
 342 union_body:
 343         '{' union_elements '}' { $_[2] }
 344 ;
 345
 346 opt_union_body:
 347         #empty
 348         |
 349         union_body
 350 ;
 351
 352 union:
 353         property_list 'union' optional_identifier opt_union_body
 354         {{
 355                 "TYPE" => "UNION",
 356                 "PROPERTIES" => $_[1],
 357                 "NAME" => $_[3],
 358                 "ELEMENTS" => $_[4],
 359                 "FILE" => $_[0]->YYData->{FILE},
 360                 "LINE" => $_[0]->YYData->{LINE},
 361         }}
 362 ;
 363
 364 base_element:
 365         property_list type pointers identifier array_len
 366         {{
 367                 "NAME" => $_[4],
 368                 "TYPE" => $_[2],
 369                 "PROPERTIES" => $_[1],
 370                 "POINTERS" => $_[3],
 371                 "ARRAY_LEN" => $_[5],
 372                 "FILE" => $_[0]->YYData->{FILE},
 373                 "LINE" => $_[0]->YYData->{LINE},
 374         }}
 375 ;
 376
 377 pointers:
 378         #empty
 379         { 0 }
 380         |
 381         pointers '*'  { $_[1]+1 }
 382 ;
 383
 384 pipe:
 385         property_list 'pipe' type
 386         {{
 387                 "TYPE" => "PIPE",
 388                 "PROPERTIES" => $_[1],
 389                 "DATA" => $_[3],
 390                 "FILE" => $_[0]->YYData->{FILE},
 391                 "LINE" => $_[0]->YYData->{LINE},
 392         }}
 393 ;
 394
 395 element_list1:
 396         #empty
 397         { [] }
 398         |
 399         element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
 400 ;
 401
 402 optional_const:
 403         #empty
 404         |
 405         'const'
 406 ;
 407
 408 element_list2:
 409         #empty
 410         |
 411         'void'
 412         |
 413         optional_const base_element { [ $_[2] ] }
 414         |
 415         element_list2 ',' optional_const base_element { push(@{$_[1]}, $_[4]); $_[1] }
 416 ;
 417
 418 array_len:
 419         #empty { [] }
 420         |
 421         '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
 422         |
 423         '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
 424 ;
 425
 426 property_list:
 427         #empty
 428         |
 429         property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
 430 ;
 431
 432 properties:
 433         property                { $_[1] }
 434         |
 435         properties ',' property { FlattenHash([$_[1], $_[3]]); }
 436 ;
 437
 438 property:
 439         identifier                       {{ "$_[1]" => "1"     }}
 440         |
 441         identifier '(' commalisttext ')' {{ "$_[1]" => "$_[3]" }}
 442 ;
 443
 444 commalisttext:
 445         anytext
 446         |
 447         commalisttext ',' anytext { "$_[1],$_[3]" }
 448 ;
 449
 450 anytext:
 451         #empty
 452         { "" }
 453         |
 454         identifier
 455         |
 456         constant
 457         |
 458         text
 459         |
 460         anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
 461         |
 462         anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
 463         |
 464         anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
 465         |
 466         anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
 467         |
 468         anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
 469         |
 470         anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
 471         |
 472         anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
 473         |
 474         anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
 475         |
 476         anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
 477         |
 478         anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
 479         |
 480         anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
 481         |
 482         anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
 483         |
 484         anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
 485         |
 486         anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
 487         |
 488         anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
 489 ;
 490
 491 identifier:
 492         IDENTIFIER
 493 ;
 494
 495 optional_identifier:
 496         #empty { undef }
 497         |
 498         IDENTIFIER
 499 ;
 500
 501 constant:
 502         CONSTANT
 503 ;
 504
 505 text:
 506         TEXT { "\"$_[1]\"" }
 507 ;
 508
 509 optional_semicolon:
 510         #empty
 511         |
 512         ';'
 513 ;
 514
 515
 516 #####################################
 517 # start code
 518 %%
 519
 520 use Parse::Pidl qw(error);
 521
 522 #####################################################################
 523 # flatten an array of hashes into a single hash
 524 sub FlattenHash($)
 525 {
 526         my $a = shift;
 527         my %b;
 528         for my $d (@{$a}) {
 529                 for my $k (keys %{$d}) {
 530                 $b{$k} = $d->{$k};
 531                 }
 532         }
 533         return \%b;
 534 }
 535
 536 #####################################################################
 537 # traverse a perl data structure removing any empty arrays or
 538 # hashes and any hash elements that map to undef
 539 sub CleanData($)
 540 {
 541         sub CleanData($);
 542         my($v) = shift;
 543
 544         return undef if (not defined($v));
 545
 546         if (ref($v) eq "ARRAY") {
 547                 foreach my $i (0 .. $#{$v}) {
 548                         CleanData($v->[$i]);
 549                 }
 550                 # this removes any undefined elements from the array
 551                 @{$v} = grep { defined $_ } @{$v};
 552         } elsif (ref($v) eq "HASH") {
 553                 foreach my $x (keys %{$v}) {
 554                         CleanData($v->{$x});
 555                         if (!defined $v->{$x}) {
 556                                 delete($v->{$x});
 557                                 next;
 558                         }
 559                 }
 560         }
 561
 562         return $v;
 563 }
 564
 565 sub _Error {
 566         if (exists $_[0]->YYData->{ERRMSG}) {
 567                 error($_[0]->YYData, $_[0]->YYData->{ERRMSG});
 568                 delete $_[0]->YYData->{ERRMSG};
 569                 return;
 570         }
 571
 572         my $last_token = $_[0]->YYData->{LAST_TOKEN};
 573
 574         error($_[0]->YYData, "Syntax error near '$last_token'");
 575 }
 576
 577 sub _Lexer($)
 578 {
 579         my($parser)=shift;
 580
 581         $parser->YYData->{INPUT} or return('',undef);
 582
 583 again:
 584         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
 585
 586         for ($parser->YYData->{INPUT}) {
 587                 if (/^\#/) {
 588                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
 589                                 $parser->YYData->{LINE} = $1-1;
 590                                 $parser->YYData->{FILE} = $2;
 591                                 goto again;
 592                         }
 593                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
 594                                 $parser->YYData->{LINE} = $1-1;
 595                                 $parser->YYData->{FILE} = $2;
 596                                 goto again;
 597                         }
 598                         if (s/^(\#.*)$//m) {
 599                                 goto again;
 600                         }
 601                 }
 602                 if (s/^(\n)//) {
 603                         $parser->YYData->{LINE}++;
 604                         goto again;
 605                 }
 606                 if (s/^\"(.*?)\"//) {
 607                         $parser->YYData->{LAST_TOKEN} = $1;
 608                         return('TEXT',$1);
 609                 }
 610                 if (s/^(\d+)(\W|$)/$2/) {
 611                         $parser->YYData->{LAST_TOKEN} = $1;
 612                         return('CONSTANT',$1);
 613                 }
 614                 if (s/^([\w_]+)//) {
 615                         $parser->YYData->{LAST_TOKEN} = $1;
 616                         if ($1 =~
 617                             /^(coclass|interface|import|importlib
 618                               |include|cpp_quote|typedef
 619                               |union|struct|enum|bitmap|pipe
 620                               |void|const|unsigned|signed)$/x) {
 621                                 return $1;
 622                         }
 623                         return('IDENTIFIER',$1);
 624                 }
 625                 if (s/^(.)//s) {
 626                         $parser->YYData->{LAST_TOKEN} = $1;
 627                         return($1,$1);
 628                 }
 629         }
 630 }
 631
 632 sub parse_string
 633 {
 634         my ($data,$filename) = @_;
 635
 636         my $self = new Parse::Pidl::IDL;
 637
 638         $self->YYData->{FILE} = $filename;
 639         $self->YYData->{INPUT} = $data;
 640         $self->YYData->{LINE} = 0;
 641         $self->YYData->{LAST_TOKEN} = "NONE";
 642
 643         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
 644
 645         return CleanData($idl);
 646 }
 647
 648 sub parse_file($$)
 649 {
 650         my ($filename,$incdirs) = @_;
 651
 652         my $saved_delim = $/;
 653         undef $/;
 654         my $cpp = $ENV{CPP};
 655         if (! defined $cpp) {
 656                 $cpp = "cpp";
 657         }
 658         my $includes = join('',map { " -I$_" } @$incdirs);
 659         my $data = `$cpp -D__PIDL__$includes -xc $filename`;
 660         $/ = $saved_delim;
 661
 662         return parse_string($data, $filename);
 663 }