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