r19599: Fix --includedir.
[Samba/ekacnet.git] / source4 / pidl / idl.yp
blob57061800b63fbbb09107bd88de39378644b97b38
1 ########################
2 # IDL Parse::Yapp parser
3 # Copyright (C) Andrew Tridgell <tridge@samba.org>
4 # released under the GNU GPL version 2 or later
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   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
14 ################
15 # grammar
17 idl: 
18         #empty  { {} }
19         | idl interface { push(@{$_[1]}, $_[2]); $_[1] }
20         | idl coclass { push(@{$_[1]}, $_[2]); $_[1] }
21         | idl import { push(@{$_[1]}, $_[2]); $_[1] }
22         | idl include { push(@{$_[1]}, $_[2]); $_[1] }
23         | idl importlib { push(@{$_[1]}, $_[2]); $_[1] }
26 import: 'import' commalist ';' {{
27                         "TYPE" => "IMPORT", 
28                         "PATHS" => $_[2],
29                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
30                    "LINE" => $_[0]->YYData->{LINE}
31                 }}
33 include: 'include' commalist ';' {{ 
34                         "TYPE" => "INCLUDE", 
35                         "PATHS" => $_[2],
36                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
37                    "LINE" => $_[0]->YYData->{LINE}
38                 }}
40 importlib: 'importlib' commalist ';' {{ 
41                         "TYPE" => "IMPORTLIB", 
42                         "PATHS" => $_[2],
43                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
44                    "LINE" => $_[0]->YYData->{LINE}
45                 }}
48 commalist: 
49       text { [ $_[1] ] }
50     | commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] }
53 coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
54           {{
55                "TYPE" => "COCLASS", 
56                "PROPERTIES" => $_[1],
57                "NAME" => $_[3],
58                "DATA" => $_[5],
59                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
60                    "LINE" => $_[0]->YYData->{LINE},
61           }}
64 interface_names:
65         #empty { {} }
66         | interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
69 interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
70           {{
71                "TYPE" => "INTERFACE", 
72                "PROPERTIES" => $_[1],
73                "NAME" => $_[3],
74                "BASE" => $_[4],
75                "DATA" => $_[6],
76                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
77                    "LINE" => $_[0]->YYData->{LINE},
78           }}
81 base_interface:
82         #empty
83         | ':' identifier { $_[2] }
86 definitions: 
87       definition              { [ $_[1] ] }    
88     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
89 ;    
92 definition: function | const | typedef | declare | typedecl
95 const: 'const' identifier pointers identifier '=' anytext ';' 
96         {{
97                      "TYPE"  => "CONST", 
98                      "DTYPE"  => $_[2],
99                          "POINTERS" => $_[3],
100                      "NAME"  => $_[4],
101                      "VALUE" => $_[6],
102                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
103                      "LINE" => $_[0]->YYData->{LINE},
104         }}
105         | 'const' identifier pointers identifier array_len '=' anytext ';' 
106         {{
107                      "TYPE"  => "CONST", 
108                      "DTYPE"  => $_[2],
109                          "POINTERS" => $_[3],
110                      "NAME"  => $_[4],
111                      "ARRAY_LEN" => $_[5],
112                      "VALUE" => $_[7],
113                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
114                      "LINE" => $_[0]->YYData->{LINE},
115         }}
119 function: property_list type identifier '(' element_list2 ')' ';' 
120          {{
121                 "TYPE" => "FUNCTION",
122                 "NAME" => $_[3],
123                 "RETURN_TYPE" => $_[2],
124                 "PROPERTIES" => $_[1],
125                 "ELEMENTS" => $_[5],
126                 "FILE" => $_[0]->YYData->{INPUT_FILENAME},
127                 "LINE" => $_[0]->YYData->{LINE},
128           }}
131 declare: 'declare' property_list decl_type identifier';' 
132         {{
133                      "TYPE" => "DECLARE", 
134                      "PROPERTIES" => $_[2],
135                      "NAME" => $_[4],
136                      "DATA" => $_[3],
137                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
138                      "LINE" => $_[0]->YYData->{LINE},
139         }}
142 decl_type: decl_enum | decl_bitmap | decl_union
145 decl_enum: 'enum' 
146         {{
147                      "TYPE" => "ENUM"
148         }}
151 decl_bitmap: 'bitmap' 
152         {{
153                      "TYPE" => "BITMAP"
154         }}
157 decl_union: 'union' 
158         {{
159                      "TYPE" => "UNION"
160         }}
163 typedef: 'typedef' property_list type identifier array_len ';' 
164         {{
165                      "TYPE" => "TYPEDEF", 
166                      "PROPERTIES" => $_[2],
167                      "NAME" => $_[4],
168                      "DATA" => $_[3],
169                      "ARRAY_LEN" => $_[5],
170                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
171                      "LINE" => $_[0]->YYData->{LINE},
172         }}
175 usertype: struct | union | enum | bitmap;
177 typedecl: usertype ';' { $_[1] };
179 sign: 'signed' | 'unsigned';
181 existingtype: 
182         | sign identifier { "$_[1] $_[2]" }
183         | identifier 
186 type: usertype | existingtype | void { "void" } ;
188 enum_body: '{' enum_elements '}' { $_[2] };
189 opt_enum_body: | enum_body;
190 enum: 'enum' optional_identifier opt_enum_body
191         {{
192              "TYPE" => "ENUM", 
193                          "NAME" => $_[2],
194                      "ELEMENTS" => $_[3]
195         }}
198 enum_elements: 
199       enum_element                    { [ $_[1] ] }            
200     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
203 enum_element: identifier 
204               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
207 bitmap_body: '{' opt_bitmap_elements '}' { $_[2] };
208 opt_bitmap_body: | bitmap_body;
209 bitmap: 'bitmap' optional_identifier opt_bitmap_body
210         {{
211              "TYPE" => "BITMAP", 
212                          "NAME" => $_[2],
213                      "ELEMENTS" => $_[3]
214         }}
217 bitmap_elements: 
218       bitmap_element                    { [ $_[1] ] }            
219     | bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
222 opt_bitmap_elements: | bitmap_elements;
224 bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
227 struct_body: '{' element_list1 '}' { $_[2] };
228 opt_struct_body: | struct_body;
230 struct: 'struct' optional_identifier opt_struct_body
231         {{
232              "TYPE" => "STRUCT", 
233                          "NAME" => $_[2],
234                      "ELEMENTS" => $_[3]
235         }}
238 empty_element: property_list ';'
239         {{
240                  "NAME" => "",
241                  "TYPE" => "EMPTY",
242                  "PROPERTIES" => $_[1],
243                  "POINTERS" => 0,
244                  "ARRAY_LEN" => [],
245                  "FILE" => $_[0]->YYData->{INPUT_FILENAME},
246                  "LINE" => $_[0]->YYData->{LINE},
247          }}
250 base_or_empty: base_element ';' | empty_element;
252 optional_base_element:
253         property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
256 union_elements: 
257     #empty
258     | union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
261 union_body: '{' union_elements '}' { $_[2] };
262 opt_union_body: | union_body;
264 union: 'union' optional_identifier opt_union_body
265         {{
266              "TYPE" => "UNION", 
267                      "NAME" => $_[2],
268                      "ELEMENTS" => $_[3]
269         }}
272 base_element: property_list type pointers identifier array_len
273               {{
274                            "NAME" => $_[4],
275                            "TYPE" => $_[2],
276                            "PROPERTIES" => $_[1],
277                            "POINTERS" => $_[3],
278                            "ARRAY_LEN" => $_[5],
279                        "FILE" => $_[0]->YYData->{INPUT_FILENAME},
280                        "LINE" => $_[0]->YYData->{LINE},
281               }}
285 pointers: 
286   #empty            
287    { 0 }
288     | pointers '*'  { $_[1]+1 }
291 element_list1: 
292     #empty
293     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
296 element_list2: 
297     #empty
298     | 'void' 
299     | base_element { [ $_[1] ] }
300     | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[1] }
303 array_len: 
304     #empty                        { [] }
305     | '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
306     | '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
310 property_list: 
311     #empty
312     | property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
315 properties: property          { $_[1] }
316     | properties ',' property { FlattenHash([$_[1], $_[3]]); }
319 property: identifier                   {{ "$_[1]" => "1"     }}
320           | identifier '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
323 listtext:
324     anytext 
325     | listtext ',' anytext { "$_[1] $_[3]" }
328 commalisttext:
329     anytext 
330     | commalisttext ',' anytext { "$_[1],$_[3]" }
333 anytext:  #empty
334     { "" }
335     | identifier | constant | text
336     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
337     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
338     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
339     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
340     | anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
341     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
342     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
343     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
344     | anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
345     | anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
346     | anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
347     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
348     | anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
349     | anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
350     | anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
353 identifier: IDENTIFIER
356 optional_identifier: 
357         IDENTIFIER
358    | #empty { undef }
361 constant: CONSTANT
364 text: TEXT { "\"$_[1]\"" }
367 optional_semicolon: 
368         #empty
369         | ';'
373 #####################################
374 # start code
377 #####################################################################
378 # flatten an array of hashes into a single hash
379 sub FlattenHash($) 
381     my $a = shift;
382     my %b;
383     for my $d (@{$a}) {
384         for my $k (keys %{$d}) {
385             $b{$k} = $d->{$k};
386         }
387     }
388     return \%b;
393 #####################################################################
394 # traverse a perl data structure removing any empty arrays or
395 # hashes and any hash elements that map to undef
396 sub CleanData($)
398     sub CleanData($);
399     my($v) = shift;
400         return undef if (not defined($v));
401     if (ref($v) eq "ARRAY") {
402         foreach my $i (0 .. $#{$v}) {
403             CleanData($v->[$i]);
404             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
405                     $v->[$i] = undef; 
406                     next; 
407             }
408         }
409         # this removes any undefined elements from the array
410         @{$v} = grep { defined $_ } @{$v};
411     } elsif (ref($v) eq "HASH") {
412         foreach my $x (keys %{$v}) {
413             CleanData($v->{$x});
414             if (!defined $v->{$x}) { delete($v->{$x}); next; }
415             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
416         }
417     }
418         return $v;
421 sub _Error {
422     if (exists $_[0]->YYData->{ERRMSG}) {
423                 print $_[0]->YYData->{ERRMSG};
424                 delete $_[0]->YYData->{ERRMSG};
425                 return;
426         };
427         my $line = $_[0]->YYData->{LINE};
428         my $last_token = $_[0]->YYData->{LAST_TOKEN};
429         my $file = $_[0]->YYData->{INPUT_FILENAME};
430         
431         print "$file:$line: Syntax error near '$last_token'\n";
434 sub _Lexer($)
436         my($parser)=shift;
438     $parser->YYData->{INPUT} or return('',undef);
440 again:
441         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
443         for ($parser->YYData->{INPUT}) {
444                 if (/^\#/) {
445                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
446                                 $parser->YYData->{LINE} = $1-1;
447                                 $parser->YYData->{INPUT_FILENAME} = $2;
448                                 goto again;
449                         }
450                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
451                                 $parser->YYData->{LINE} = $1-1;
452                                 $parser->YYData->{INPUT_FILENAME} = $2;
453                                 goto again;
454                         }
455                         if (s/^(\#.*)$//m) {
456                                 goto again;
457                         }
458                 }
459                 if (s/^(\n)//) {
460                         $parser->YYData->{LINE}++;
461                         goto again;
462                 }
463                 if (s/^\"(.*?)\"//) {
464                         $parser->YYData->{LAST_TOKEN} = $1;
465                         return('TEXT',$1); 
466                 }
467                 if (s/^(\d+)(\W|$)/$2/) {
468                         $parser->YYData->{LAST_TOKEN} = $1;
469                         return('CONSTANT',$1); 
470                 }
471                 if (s/^([\w_]+)//) {
472                         $parser->YYData->{LAST_TOKEN} = $1;
473                         if ($1 =~ 
474                             /^(coclass|interface|const|typedef|declare|union
475                               |struct|enum|bitmap|void|unsigned|signed|import|include
476                                   |importlib)$/x) {
477                                 return $1;
478                         }
479                         return('IDENTIFIER',$1);
480                 }
481                 if (s/^(.)//s) {
482                         $parser->YYData->{LAST_TOKEN} = $1;
483                         return($1,$1);
484                 }
485         }
488 sub parse_string
490         my ($data,$filename) = @_;
492         my $self = new Parse::Pidl::IDL;
494     $self->YYData->{INPUT_FILENAME} = $filename;
495     $self->YYData->{INPUT} = $data;
496     $self->YYData->{LINE} = 0;
497     $self->YYData->{LAST_TOKEN} = "NONE";
499         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
501         return CleanData($idl);
504 sub parse_file($$)
506         my ($filename,$incdirs) = @_;
508         my $saved_delim = $/;
509         undef $/;
510         my $cpp = $ENV{CPP};
511         if (! defined $cpp) {
512                 $cpp = "cpp";
513         }
514         my $includes = join('',map { " -I$_" } @$incdirs);
515         my $data = `$cpp -D__PIDL__$includes -xc $filename`;
516         $/ = $saved_delim;
518         return parse_string($data, $filename);