pidl: fix formatting in idl.yp
[ira/wip.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         |
20         idl interface { push(@{$_[1]}, $_[2]); $_[1] }
21         |
22         idl coclass   { push(@{$_[1]}, $_[2]); $_[1] }
23         |
24         idl import    { push(@{$_[1]}, $_[2]); $_[1] }
25         |
26         idl include   { push(@{$_[1]}, $_[2]); $_[1] }
27         |
28         idl importlib { push(@{$_[1]}, $_[2]); $_[1] }
29         |
30         idl cpp_quote { push(@{$_[1]}, $_[2]); $_[1] }
31 ;
32
33 import:
34         'import' commalist ';'
35         {{
36                 "TYPE" => "IMPORT",
37                 "PATHS" => $_[2],
38                 "FILE" => $_[0]->YYData->{FILE},
39                 "LINE" => $_[0]->YYData->{LINE},
40         }}
41 ;
42
43 include:
44         'include' commalist ';'
45         {{
46                 "TYPE" => "INCLUDE",
47                 "PATHS" => $_[2],
48                 "FILE" => $_[0]->YYData->{FILE},
49                 "LINE" => $_[0]->YYData->{LINE},
50         }}
51 ;
52
53 importlib:
54         'importlib' commalist ';'
55         {{
56                 "TYPE" => "IMPORTLIB",
57                 "PATHS" => $_[2],
58                 "FILE" => $_[0]->YYData->{FILE},
59                 "LINE" => $_[0]->YYData->{LINE},
60         }}
61 ;
62
63 commalist:
64         text { [ $_[1] ] }
65         |
66         commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] }
67 ;
68
69 coclass:
70         property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
71         {{
72                 "TYPE" => "COCLASS",
73                 "PROPERTIES" => $_[1],
74                 "NAME" => $_[3],
75                 "DATA" => $_[5],
76                 "FILE" => $_[0]->YYData->{FILE},
77                 "LINE" => $_[0]->YYData->{LINE},
78         }}
79 ;
80
81 interface_names:
82         #empty { {} }
83         |
84         interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
85 ;
86
87 interface:
88         property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
89         {{
90                 "TYPE" => "INTERFACE",
91                 "PROPERTIES" => $_[1],
92                 "NAME" => $_[3],
93                 "BASE" => $_[4],
94                 "DATA" => $_[6],
95                 "FILE" => $_[0]->YYData->{FILE},
96                 "LINE" => $_[0]->YYData->{LINE},
97         }}
98 ;
99
100 base_interface:
101         #empty
102         |
103         ':' identifier { $_[2] }
104 ;
105
106
107 cpp_quote:
108         'cpp_quote' '(' text ')'
109         {{
110                  "TYPE" => "CPP_QUOTE",
111                  "DATA" => $_[3],
112                  "FILE" => $_[0]->YYData->{FILE},
113                  "LINE" => $_[0]->YYData->{LINE},
114         }}
115 ;
116
117 definitions:
118         definition              { [ $_[1] ] }
119         |
120         definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
121 ;
122
123 definition:
124         function
125         |
126         const
127         |
128         typedef
129         |
130         typedecl
131 ;
132
133 const:
134         'const' identifier pointers identifier '=' anytext ';'
135         {{
136                 "TYPE"  => "CONST",
137                 "DTYPE"  => $_[2],
138                 "POINTERS" => $_[3],
139                 "NAME"  => $_[4],
140                 "VALUE" => $_[6],
141                 "FILE" => $_[0]->YYData->{FILE},
142                 "LINE" => $_[0]->YYData->{LINE},
143         }}
144         |
145         'const' identifier pointers identifier array_len '=' anytext ';'
146         {{
147                 "TYPE"  => "CONST",
148                 "DTYPE"  => $_[2],
149                 "POINTERS" => $_[3],
150                 "NAME"  => $_[4],
151                 "ARRAY_LEN" => $_[5],
152                 "VALUE" => $_[7],
153                 "FILE" => $_[0]->YYData->{FILE},
154                 "LINE" => $_[0]->YYData->{LINE},
155         }}
156 ;
157
158 function:
159         property_list type identifier '(' element_list2 ')' ';'
160         {{
161                 "TYPE" => "FUNCTION",
162                 "NAME" => $_[3],
163                 "RETURN_TYPE" => $_[2],
164                 "PROPERTIES" => $_[1],
165                 "ELEMENTS" => $_[5],
166                 "FILE" => $_[0]->YYData->{FILE},
167                 "LINE" => $_[0]->YYData->{LINE},
168         }}
169 ;
170
171 typedef:
172         property_list 'typedef' type identifier array_len ';'
173         {{
174                 "TYPE" => "TYPEDEF",
175                 "PROPERTIES" => $_[1],
176                 "NAME" => $_[4],
177                 "DATA" => $_[3],
178                 "ARRAY_LEN" => $_[5],
179                 "FILE" => $_[0]->YYData->{FILE},
180                 "LINE" => $_[0]->YYData->{LINE},
181         }}
182 ;
183
184 usertype:
185         struct
186         |
187         union
188         |
189         enum
190         |
191         bitmap
192 ;
193
194 typedecl:
195         usertype ';' { $_[1] }
196 ;
197
198 sign:
199         'signed'
200         |
201         'unsigned'
202 ;
203
204 existingtype:
205         sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" }
206         |
207         identifier
208 ;
209
210 type:
211         usertype
212         |
213         existingtype
214         |
215         void { "void" }
216 ;
217
218 enum_body:
219         '{' enum_elements '}' { $_[2] }
220 ;
221
222 opt_enum_body:
223         #empty
224         |
225         enum_body
226 ;
227
228 enum:
229         property_list 'enum' optional_identifier opt_enum_body
230         {{
231                 "TYPE" => "ENUM",
232                 "PROPERTIES" => $_[1],
233                 "NAME" => $_[3],
234                 "ELEMENTS" => $_[4],
235                 "FILE" => $_[0]->YYData->{FILE},
236                 "LINE" => $_[0]->YYData->{LINE},
237         }}
238 ;
239
240 enum_elements:
241         enum_element                    { [ $_[1] ] }
242         |
243         enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
244 ;
245
246 enum_element:
247         identifier
248         |
249         identifier '=' anytext { "$_[1]$_[2]$_[3]" }
250 ;
251
252 bitmap_body:
253         '{' opt_bitmap_elements '}' { $_[2] }
254 ;
255
256 opt_bitmap_body:
257         #empty
258         |
259         bitmap_body
260 ;
261
262 bitmap:
263         property_list 'bitmap' optional_identifier opt_bitmap_body
264         {{
265                 "TYPE" => "BITMAP",
266                 "PROPERTIES" => $_[1],
267                 "NAME" => $_[3],
268                 "ELEMENTS" => $_[4],
269                 "FILE" => $_[0]->YYData->{FILE},
270                 "LINE" => $_[0]->YYData->{LINE},
271         }}
272 ;
273
274 bitmap_elements:
275         bitmap_element                      { [ $_[1] ] }
276         |
277         bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
278 ;
279
280 opt_bitmap_elements:
281         #empty
282         |
283         bitmap_elements
284 ;
285
286 bitmap_element:
287         identifier '=' anytext { "$_[1] ( $_[3] )" }
288 ;
289
290 struct_body:
291         '{' element_list1 '}' { $_[2] }
292 ;
293
294 opt_struct_body:
295         #empty
296         |
297         struct_body
298 ;
299
300 struct:
301         property_list 'struct' optional_identifier opt_struct_body
302         {{
303                 "TYPE" => "STRUCT",
304                 "PROPERTIES" => $_[1],
305                 "NAME" => $_[3],
306                 "ELEMENTS" => $_[4],
307                 "FILE" => $_[0]->YYData->{FILE},
308                 "LINE" => $_[0]->YYData->{LINE},
309         }}
310 ;
311
312 empty_element:
313         property_list ';'
314         {{
315                 "NAME" => "",
316                 "TYPE" => "EMPTY",
317                 "PROPERTIES" => $_[1],
318                 "POINTERS" => 0,
319                 "ARRAY_LEN" => [],
320                 "FILE" => $_[0]->YYData->{FILE},
321                 "LINE" => $_[0]->YYData->{LINE},
322         }}
323 ;
324
325 base_or_empty:
326         base_element ';'
327         |
328         empty_element;
329
330 optional_base_element:
331         property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
332 ;
333
334 union_elements:
335         #empty
336         |
337         union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
338 ;
339
340 union_body:
341         '{' union_elements '}' { $_[2] }
342 ;
343
344 opt_union_body:
345         #empty
346         |
347         union_body
348 ;
349
350 union:
351         property_list 'union' optional_identifier opt_union_body
352         {{
353                 "TYPE" => "UNION",
354                 "PROPERTIES" => $_[1],
355                 "NAME" => $_[3],
356                 "ELEMENTS" => $_[4],
357                 "FILE" => $_[0]->YYData->{FILE},
358                 "LINE" => $_[0]->YYData->{LINE},
359         }}
360 ;
361
362 base_element:
363         property_list type pointers identifier array_len
364         {{
365                 "NAME" => $_[4],
366                 "TYPE" => $_[2],
367                 "PROPERTIES" => $_[1],
368                 "POINTERS" => $_[3],
369                 "ARRAY_LEN" => $_[5],
370                 "FILE" => $_[0]->YYData->{FILE},
371                 "LINE" => $_[0]->YYData->{LINE},
372         }}
373 ;
374
375 pointers:
376         #empty
377         { 0 }
378         |
379         pointers '*'  { $_[1]+1 }
380 ;
381
382 element_list1:
383         #empty
384         { [] }
385         |
386         element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
387 ;
388
389 optional_const:
390         #empty
391         |
392         'const'
393 ;
394
395 element_list2:
396         #empty
397         |
398         'void'
399         |
400         optional_const base_element { [ $_[2] ] }
401         |
402         element_list2 ',' optional_const base_element { push(@{$_[1]}, $_[4]); $_[1] }
403 ;
404
405 array_len:
406         #empty { [] }
407         |
408         '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
409         |
410         '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
411 ;
412
413 property_list:
414         #empty
415         |
416         property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
417 ;
418
419 properties:
420         property                { $_[1] }
421         |
422         properties ',' property { FlattenHash([$_[1], $_[3]]); }
423 ;
424
425 property:
426         identifier                       {{ "$_[1]" => "1"     }}
427         |
428         identifier '(' commalisttext ')' {{ "$_[1]" => "$_[3]" }}
429 ;
430
431 commalisttext:
432         anytext
433         |
434         commalisttext ',' anytext { "$_[1],$_[3]" }
435 ;
436
437 anytext:
438         #empty
439         { "" }
440         |
441         identifier
442         |
443         constant
444         |
445         text
446         |
447         anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
448         |
449         anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
450         |
451         anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
452         |
453         anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
454         |
455         anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
456         |
457         anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
458         |
459         anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
460         |
461         anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
462         |
463         anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
464         |
465         anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
466         |
467         anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
468         |
469         anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
470         |
471         anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
472         |
473         anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
474         |
475         anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
476 ;
477
478 identifier:
479         IDENTIFIER
480 ;
481
482 optional_identifier:
483         #empty { undef }
484         |
485         IDENTIFIER
486 ;
487
488 constant:
489         CONSTANT
490 ;
491
492 text:
493         TEXT { "\"$_[1]\"" }
494 ;
495
496 optional_semicolon:
497         #empty
498         |
499         ';'
500 ;
501
502
503 #####################################
504 # start code
505 %%
506
507 use Parse::Pidl qw(error);
508
509 #####################################################################
510 # flatten an array of hashes into a single hash
511 sub FlattenHash($)
512 {
513         my $a = shift;
514         my %b;
515         for my $d (@{$a}) {
516                 for my $k (keys %{$d}) {
517                 $b{$k} = $d->{$k};
518                 }
519         }
520         return \%b;
521 }
522
523 #####################################################################
524 # traverse a perl data structure removing any empty arrays or
525 # hashes and any hash elements that map to undef
526 sub CleanData($)
527 {
528         sub CleanData($);
529         my($v) = shift;
530
531         return undef if (not defined($v));
532
533         if (ref($v) eq "ARRAY") {
534                 foreach my $i (0 .. $#{$v}) {
535                         CleanData($v->[$i]);
536                 }
537                 # this removes any undefined elements from the array
538                 @{$v} = grep { defined $_ } @{$v};
539         } elsif (ref($v) eq "HASH") {
540                 foreach my $x (keys %{$v}) {
541                         CleanData($v->{$x});
542                         if (!defined $v->{$x}) {
543                                 delete($v->{$x});
544                                 next;
545                         }
546                 }
547         }
548
549         return $v;
550 }
551
552 sub _Error {
553         if (exists $_[0]->YYData->{ERRMSG}) {
554                 error($_[0]->YYData, $_[0]->YYData->{ERRMSG});
555                 delete $_[0]->YYData->{ERRMSG};
556                 return;
557         }
558
559         my $last_token = $_[0]->YYData->{LAST_TOKEN};
560
561         error($_[0]->YYData, "Syntax error near '$last_token'");
562 }
563
564 sub _Lexer($)
565 {
566         my($parser)=shift;
567
568         $parser->YYData->{INPUT} or return('',undef);
569
570 again:
571         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
572
573         for ($parser->YYData->{INPUT}) {
574                 if (/^\#/) {
575                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
576                                 $parser->YYData->{LINE} = $1-1;
577                                 $parser->YYData->{FILE} = $2;
578                                 goto again;
579                         }
580                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
581                                 $parser->YYData->{LINE} = $1-1;
582                                 $parser->YYData->{FILE} = $2;
583                                 goto again;
584                         }
585                         if (s/^(\#.*)$//m) {
586                                 goto again;
587                         }
588                 }
589                 if (s/^(\n)//) {
590                         $parser->YYData->{LINE}++;
591                         goto again;
592                 }
593                 if (s/^\"(.*?)\"//) {
594                         $parser->YYData->{LAST_TOKEN} = $1;
595                         return('TEXT',$1);
596                 }
597                 if (s/^(\d+)(\W|$)/$2/) {
598                         $parser->YYData->{LAST_TOKEN} = $1;
599                         return('CONSTANT',$1);
600                 }
601                 if (s/^([\w_]+)//) {
602                         $parser->YYData->{LAST_TOKEN} = $1;
603                         if ($1 =~
604                             /^(coclass|interface|import|importlib
605                               |include|cpp_quote|typedef
606                               |union|struct|enum|bitmap
607                               |void|const|unsigned|signed)$/x) {
608                                 return $1;
609                         }
610                         return('IDENTIFIER',$1);
611                 }
612                 if (s/^(.)//s) {
613                         $parser->YYData->{LAST_TOKEN} = $1;
614                         return($1,$1);
615                 }
616         }
617 }
618
619 sub parse_string
620 {
621         my ($data,$filename) = @_;
622
623         my $self = new Parse::Pidl::IDL;
624
625         $self->YYData->{FILE} = $filename;
626         $self->YYData->{INPUT} = $data;
627         $self->YYData->{LINE} = 0;
628         $self->YYData->{LAST_TOKEN} = "NONE";
629
630         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
631
632         return CleanData($idl);
633 }
634
635 sub parse_file($$)
636 {
637         my ($filename,$incdirs) = @_;
638
639         my $saved_delim = $/;
640         undef $/;
641         my $cpp = $ENV{CPP};
642         if (! defined $cpp) {
643                 $cpp = "cpp";
644         }
645         my $includes = join('',map { " -I$_" } @$incdirs);
646         my $data = `$cpp -D__PIDL__$includes -xc $filename`;
647         $/ = $saved_delim;
648
649         return parse_string($data, $filename);
650 }