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