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