Only define _GNU_SOURCE if it's not defined yet.
[ab/samba.git/.git] / pidl / idl.yp
1 ########################
2 # IDL Parse::Yapp parser
3 # Copyright (C) Andrew Tridgell <tridge@samba.org>
4 # released under the GNU GPL version 3 or later
5
6
7
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   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
12
13
14 ################
15 # grammar
16 %%
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] }
24         | idl cpp_quote { push(@{$_[1]}, $_[2]); $_[1] }
25 ;
26
27 import: 'import' commalist ';' {{
28                         "TYPE" => "IMPORT", 
29                         "PATHS" => $_[2],
30                    "FILE" => $_[0]->YYData->{FILE},
31                    "LINE" => $_[0]->YYData->{LINE}
32                 }}
33 ;
34 include: 'include' commalist ';' {{ 
35                         "TYPE" => "INCLUDE", 
36                         "PATHS" => $_[2],
37                    "FILE" => $_[0]->YYData->{FILE},
38                    "LINE" => $_[0]->YYData->{LINE}
39                 }}
40 ;
41 importlib: 'importlib' commalist ';' {{ 
42                         "TYPE" => "IMPORTLIB", 
43                         "PATHS" => $_[2],
44                    "FILE" => $_[0]->YYData->{FILE},
45                    "LINE" => $_[0]->YYData->{LINE}
46                 }}
47 ;
48
49 commalist: 
50       text { [ $_[1] ] }
51     | commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] }
52 ;
53
54 coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
55           {{
56                "TYPE" => "COCLASS", 
57                "PROPERTIES" => $_[1],
58                "NAME" => $_[3],
59                "DATA" => $_[5],
60                    "FILE" => $_[0]->YYData->{FILE},
61                    "LINE" => $_[0]->YYData->{LINE},
62           }}
63 ;
64
65 interface_names:
66         #empty { {} }
67         | interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
68 ;
69
70 interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
71           {{
72                "TYPE" => "INTERFACE", 
73                "PROPERTIES" => $_[1],
74                "NAME" => $_[3],
75                    "BASE" => $_[4],
76                "DATA" => $_[6],
77                    "FILE" => $_[0]->YYData->{FILE},
78                    "LINE" => $_[0]->YYData->{LINE},
79           }}
80 ;
81
82 base_interface:
83     #empty
84     | ':' identifier { $_[2] }
85 ;
86
87
88 cpp_quote: 'cpp_quote' '(' text ')'
89         {{
90                  "TYPE" => "CPP_QUOTE",
91                  "FILE" => $_[0]->YYData->{FILE},
92                  "LINE" => $_[0]->YYData->{LINE},
93                  "DATA" => $_[3]
94         }}
95 ;
96
97 definitions: 
98       definition              { [ $_[1] ] }    
99     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
100 ;    
101
102
103 definition: function | const | typedef | typedecl
104 ;
105
106 const: 'const' identifier pointers identifier '=' anytext ';' 
107         {{
108                      "TYPE"  => "CONST", 
109                      "DTYPE"  => $_[2],
110                          "POINTERS" => $_[3],
111                      "NAME"  => $_[4],
112                      "VALUE" => $_[6],
113                      "FILE" => $_[0]->YYData->{FILE},
114                      "LINE" => $_[0]->YYData->{LINE},
115         }}
116         | 'const' identifier pointers identifier array_len '=' anytext ';' 
117         {{
118                      "TYPE"  => "CONST", 
119                      "DTYPE"  => $_[2],
120                          "POINTERS" => $_[3],
121                      "NAME"  => $_[4],
122                      "ARRAY_LEN" => $_[5],
123                      "VALUE" => $_[7],
124                      "FILE" => $_[0]->YYData->{FILE},
125                      "LINE" => $_[0]->YYData->{LINE},
126         }}
127 ;
128
129
130 function: property_list type identifier '(' element_list2 ')' ';' 
131          {{
132                 "TYPE" => "FUNCTION",
133                 "NAME" => $_[3],
134                 "RETURN_TYPE" => $_[2],
135                 "PROPERTIES" => $_[1],
136                 "ELEMENTS" => $_[5],
137                 "FILE" => $_[0]->YYData->{FILE},
138                 "LINE" => $_[0]->YYData->{LINE},
139           }}
140 ;
141
142 typedef: property_list 'typedef' type identifier array_len ';' 
143         {{
144                      "TYPE" => "TYPEDEF", 
145                      "PROPERTIES" => $_[1],
146                      "NAME" => $_[4],
147                      "DATA" => $_[3],
148                      "ARRAY_LEN" => $_[5],
149                      "FILE" => $_[0]->YYData->{FILE},
150                      "LINE" => $_[0]->YYData->{LINE},
151         }}
152 ;
153
154 usertype: struct | union | enum | bitmap;
155
156 typedecl: usertype ';' { $_[1] };
157
158 sign: 'signed' | 'unsigned';
159
160 existingtype: 
161         sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" }
162         | identifier 
163 ;
164
165 type: usertype | existingtype | void { "void" } ;
166
167 enum_body: '{' enum_elements '}' { $_[2] };
168 opt_enum_body: | enum_body;
169 enum: property_list 'enum' optional_identifier opt_enum_body
170         {{
171              "TYPE" => "ENUM", 
172                          "PROPERTIES" => $_[1],
173                          "NAME" => $_[3],
174                      "ELEMENTS" => $_[4]
175         }}
176 ;
177
178 enum_elements: 
179       enum_element                    { [ $_[1] ] }            
180     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
181 ;
182
183 enum_element: identifier 
184               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
185 ;
186
187 bitmap_body: '{' opt_bitmap_elements '}' { $_[2] };
188 opt_bitmap_body: | bitmap_body;
189 bitmap: property_list 'bitmap' optional_identifier opt_bitmap_body
190         {{
191              "TYPE" => "BITMAP", 
192                      "PROPERTIES" => $_[1],
193                          "NAME" => $_[3],
194                      "ELEMENTS" => $_[4]
195         }}
196 ;
197
198 bitmap_elements: 
199       bitmap_element                    { [ $_[1] ] }            
200     | bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
201 ;
202
203 opt_bitmap_elements: | bitmap_elements;
204
205 bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
206 ;
207
208 struct_body: '{' element_list1 '}' { $_[2] };
209 opt_struct_body: | struct_body;
210
211 struct: property_list 'struct' optional_identifier opt_struct_body
212         {{
213              "TYPE" => "STRUCT", 
214                          "PROPERTIES" => $_[1],
215                          "NAME" => $_[3],
216                      "ELEMENTS" => $_[4]
217         }}
218 ;
219
220 empty_element: property_list ';'
221         {{
222                  "NAME" => "",
223                  "TYPE" => "EMPTY",
224                  "PROPERTIES" => $_[1],
225                  "POINTERS" => 0,
226                  "ARRAY_LEN" => [],
227                  "FILE" => $_[0]->YYData->{FILE},
228                  "LINE" => $_[0]->YYData->{LINE},
229          }}
230 ;
231
232 base_or_empty: base_element ';' | empty_element;
233
234 optional_base_element:
235         property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
236 ;
237
238 union_elements: 
239     #empty
240     | union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
241 ;
242
243 union_body: '{' union_elements '}' { $_[2] };
244 opt_union_body: | union_body;
245
246 union: property_list 'union' optional_identifier opt_union_body
247         {{
248              "TYPE" => "UNION", 
249                          "PROPERTIES" => $_[1],
250                      "NAME" => $_[3],
251                      "ELEMENTS" => $_[4]
252         }}
253 ;
254
255 base_element: property_list type pointers identifier array_len
256               {{
257                            "NAME" => $_[4],
258                            "TYPE" => $_[2],
259                            "PROPERTIES" => $_[1],
260                            "POINTERS" => $_[3],
261                            "ARRAY_LEN" => $_[5],
262                        "FILE" => $_[0]->YYData->{FILE},
263                        "LINE" => $_[0]->YYData->{LINE},
264               }}
265 ;
266
267
268 pointers: 
269   #empty            
270    { 0 }
271     | pointers '*'  { $_[1]+1 }
272 ;
273
274 element_list1: 
275         { [] }
276     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
277 ;
278
279 optional_const: 
280         #empty
281         | 'const'
282 ;
283
284 element_list2: 
285     #empty
286     | 'void' 
287     | optional_const base_element { [ $_[2] ] }
288     | element_list2 ',' optional_const base_element { push(@{$_[1]}, $_[4]); $_[1] }
289 ;
290
291 array_len: 
292     #empty                        { [] }
293     | '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
294     | '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
295 ;
296
297
298 property_list: 
299     #empty
300     | property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
301 ;
302
303 properties: property          { $_[1] }
304     | properties ',' property { FlattenHash([$_[1], $_[3]]); }
305 ;
306
307 property: identifier                   {{ "$_[1]" => "1"     }}
308           | identifier '(' commalisttext ')' {{ "$_[1]" => "$_[3]" }}
309 ;
310
311 commalisttext:
312     anytext 
313     | commalisttext ',' anytext { "$_[1],$_[3]" }
314 ;
315
316 anytext:  #empty
317     { "" }
318     | identifier | constant | text
319     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
320     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
321     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
322     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
323     | anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
324     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
325     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
326     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
327     | anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
328     | anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
329     | anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
330     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
331     | anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
332     | anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
333     | anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
334 ;
335
336 identifier: IDENTIFIER
337 ;
338
339 optional_identifier: 
340         IDENTIFIER
341    | #empty { undef }
342 ;
343
344 constant: CONSTANT
345 ;
346
347 text: TEXT { "\"$_[1]\"" }
348 ;
349
350 optional_semicolon: 
351         #empty
352         | ';'
353 ;
354
355
356 #####################################
357 # start code
358 %%
359
360 use Parse::Pidl qw(error);
361
362 #####################################################################
363 # flatten an array of hashes into a single hash
364 sub FlattenHash($) 
365
366     my $a = shift;
367     my %b;
368     for my $d (@{$a}) {
369         for my $k (keys %{$d}) {
370             $b{$k} = $d->{$k};
371         }
372     }
373     return \%b;
374 }
375
376
377
378 #####################################################################
379 # traverse a perl data structure removing any empty arrays or
380 # hashes and any hash elements that map to undef
381 sub CleanData($)
382 {
383     sub CleanData($);
384     my($v) = shift;
385         return undef if (not defined($v));
386     if (ref($v) eq "ARRAY") {
387         foreach my $i (0 .. $#{$v}) {
388             CleanData($v->[$i]);
389         }
390         # this removes any undefined elements from the array
391         @{$v} = grep { defined $_ } @{$v};
392     } elsif (ref($v) eq "HASH") {
393         foreach my $x (keys %{$v}) {
394             CleanData($v->{$x});
395             if (!defined $v->{$x}) { delete($v->{$x}); next; }
396         }
397     }
398         return $v;
399 }
400
401 sub _Error {
402     if (exists $_[0]->YYData->{ERRMSG}) {
403                 error($_[0]->YYData, $_[0]->YYData->{ERRMSG});
404                 delete $_[0]->YYData->{ERRMSG};
405                 return;
406         }
407         my $last_token = $_[0]->YYData->{LAST_TOKEN};
408         
409         error($_[0]->YYData, "Syntax error near '$last_token'");
410 }
411
412 sub _Lexer($)
413 {
414         my($parser)=shift;
415
416     $parser->YYData->{INPUT} or return('',undef);
417
418 again:
419         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
420
421         for ($parser->YYData->{INPUT}) {
422                 if (/^\#/) {
423                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
424                                 $parser->YYData->{LINE} = $1-1;
425                                 $parser->YYData->{FILE} = $2;
426                                 goto again;
427                         }
428                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
429                                 $parser->YYData->{LINE} = $1-1;
430                                 $parser->YYData->{FILE} = $2;
431                                 goto again;
432                         }
433                         if (s/^(\#.*)$//m) {
434                                 goto again;
435                         }
436                 }
437                 if (s/^(\n)//) {
438                         $parser->YYData->{LINE}++;
439                         goto again;
440                 }
441                 if (s/^\"(.*?)\"//) {
442                         $parser->YYData->{LAST_TOKEN} = $1;
443                         return('TEXT',$1); 
444                 }
445                 if (s/^(\d+)(\W|$)/$2/) {
446                         $parser->YYData->{LAST_TOKEN} = $1;
447                         return('CONSTANT',$1); 
448                 }
449                 if (s/^([\w_]+)//) {
450                         $parser->YYData->{LAST_TOKEN} = $1;
451                         if ($1 =~ 
452                             /^(coclass|interface|const|typedef|union|cpp_quote
453                               |struct|enum|bitmap|void|unsigned|signed|import|include
454                                   |importlib)$/x) {
455                                 return $1;
456                         }
457                         return('IDENTIFIER',$1);
458                 }
459                 if (s/^(.)//s) {
460                         $parser->YYData->{LAST_TOKEN} = $1;
461                         return($1,$1);
462                 }
463         }
464 }
465
466 sub parse_string
467 {
468         my ($data,$filename) = @_;
469
470         my $self = new Parse::Pidl::IDL;
471
472     $self->YYData->{FILE} = $filename;
473     $self->YYData->{INPUT} = $data;
474     $self->YYData->{LINE} = 0;
475     $self->YYData->{LAST_TOKEN} = "NONE";
476
477         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
478
479         return CleanData($idl);
480 }
481
482 sub parse_file($$)
483 {
484         my ($filename,$incdirs) = @_;
485
486         my $saved_delim = $/;
487         undef $/;
488         my $cpp = $ENV{CPP};
489         if (! defined $cpp) {
490                 $cpp = "cpp";
491         }
492         my $includes = join('',map { " -I$_" } @$incdirs);
493         my $data = `$cpp -D__PIDL__$includes -xc $filename`;
494         $/ = $saved_delim;
495
496         return parse_string($data, $filename);
497 }