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