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