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