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