r9459: Move pidl up one level (to prevent too much nesting)
[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 ;
22
23 coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
24           {$_[3] => {
25                "TYPE" => "COCLASS", 
26                "PROPERTIES" => $_[1],
27                "NAME" => $_[3],
28                "DATA" => $_[5],
29                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
30                    "LINE" => $_[0]->YYData->{LINE},
31           }}
32 ;
33
34 interface_names:
35         #empty { {} }
36         | interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
37 ;
38
39 interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
40           {$_[3] => {
41                "TYPE" => "INTERFACE", 
42                "PROPERTIES" => $_[1],
43                "NAME" => $_[3],
44                "BASE" => $_[4],
45                "DATA" => $_[6],
46                    "FILE" => $_[0]->YYData->{INPUT_FILENAME},
47                    "LINE" => $_[0]->YYData->{LINE},
48           }}
49 ;
50
51 base_interface:
52         #empty
53         | ':' identifier { $_[2] }
54 ;
55
56 definitions: 
57       definition              { [ $_[1] ] }    
58     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
59 ;    
60
61
62 definition: function | const | typedef | declare | typedecl
63 ;
64
65 const: 'const' identifier identifier '=' anytext ';' 
66         {{
67                      "TYPE"  => "CONST", 
68                      "DTYPE"  => $_[2],
69                      "NAME"  => $_[3],
70                      "VALUE" => $_[5],
71                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
72                      "LINE" => $_[0]->YYData->{LINE},
73         }}
74         | 'const' identifier identifier array_len '=' anytext ';' 
75         {{
76                      "TYPE"  => "CONST", 
77                      "DTYPE"  => $_[2],
78                      "NAME"  => $_[3],
79                      "ARRAY_LEN" => $_[4],
80                      "VALUE" => $_[6],
81                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
82                      "LINE" => $_[0]->YYData->{LINE},
83         }}
84 ;
85
86
87 function: property_list type identifier '(' element_list2 ')' ';' 
88          {{
89                 "TYPE" => "FUNCTION",
90                 "NAME" => $_[3],
91                 "RETURN_TYPE" => $_[2],
92                 "PROPERTIES" => $_[1],
93                 "ELEMENTS" => $_[5],
94                 "FILE" => $_[0]->YYData->{INPUT_FILENAME},
95                 "LINE" => $_[0]->YYData->{LINE},
96           }}
97 ;
98
99 declare: 'declare' property_list decl_type identifier';' 
100         {{
101                      "TYPE" => "DECLARE", 
102                      "PROPERTIES" => $_[2],
103                      "NAME" => $_[4],
104                      "DATA" => $_[3],
105                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
106                      "LINE" => $_[0]->YYData->{LINE},
107         }}
108 ;
109
110 decl_type: decl_enum | decl_bitmap
111 ;
112
113 decl_enum: 'enum' 
114         {{
115                      "TYPE" => "ENUM"
116         }}
117 ;
118
119 decl_bitmap: 'bitmap' 
120         {{
121                      "TYPE" => "BITMAP"
122         }}
123 ;
124
125 typedef: 'typedef' property_list type identifier array_len ';' 
126         {{
127                      "TYPE" => "TYPEDEF", 
128                      "PROPERTIES" => $_[2],
129                      "NAME" => $_[4],
130                      "DATA" => $_[3],
131                      "ARRAY_LEN" => $_[5],
132                      "FILE" => $_[0]->YYData->{INPUT_FILENAME},
133                      "LINE" => $_[0]->YYData->{LINE},
134         }}
135 ;
136
137 usertype: struct | union | enum | bitmap;
138
139 typedecl: usertype ';' { $_[1] };
140
141 type: usertype | identifier 
142         | void { "void" }
143 ;
144
145 enum: 'enum' optional_identifier '{' enum_elements '}' 
146         {{
147              "TYPE" => "ENUM", 
148                          "NAME" => $_[2],
149                      "ELEMENTS" => $_[4]
150         }}
151 ;
152
153 enum_elements: 
154       enum_element                    { [ $_[1] ] }            
155     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
156 ;
157
158 enum_element: identifier 
159               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
160 ;
161
162 bitmap: 'bitmap' optional_identifier '{' bitmap_elements '}' 
163         {{
164              "TYPE" => "BITMAP", 
165                          "NAME" => $_[2],
166                      "ELEMENTS" => $_[4]
167         }}
168 ;
169
170 bitmap_elements: 
171       bitmap_element                    { [ $_[1] ] }            
172     | bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
173 ;
174
175 bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
176 ;
177
178 struct: 'struct' optional_identifier '{' element_list1 '}' 
179         {{
180              "TYPE" => "STRUCT", 
181                          "NAME" => $_[2],
182                      "ELEMENTS" => $_[4]
183         }}
184 ;
185
186 empty_element: property_list ';'
187         {{
188                  "NAME" => "",
189                  "TYPE" => "EMPTY",
190                  "PROPERTIES" => $_[1],
191                  "POINTERS" => 0,
192                  "ARRAY_LEN" => [],
193                  "FILE" => $_[0]->YYData->{INPUT_FILENAME},
194                  "LINE" => $_[0]->YYData->{LINE},
195          }}
196 ;
197
198 base_or_empty: base_element ';' | empty_element;
199
200 optional_base_element:
201         property_list base_or_empty { $_[2]->{PROPERTIES} = Parse::Pidl::Util::FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
202 ;
203
204 union_elements: 
205     #empty
206     | union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
207 ;
208
209 union: 'union' optional_identifier '{' union_elements '}' 
210         {{
211              "TYPE" => "UNION", 
212                      "NAME" => $_[2],
213                      "ELEMENTS" => $_[4]
214         }}
215 ;
216
217 base_element: property_list type pointers identifier array_len
218               {{
219                            "NAME" => $_[4],
220                            "TYPE" => $_[2],
221                            "PROPERTIES" => $_[1],
222                            "POINTERS" => $_[3],
223                            "ARRAY_LEN" => $_[5],
224                        "FILE" => $_[0]->YYData->{INPUT_FILENAME},
225                        "LINE" => $_[0]->YYData->{LINE},
226               }}
227 ;
228
229
230 pointers: 
231   #empty            
232    { 0 }
233     | pointers '*'  { $_[1]+1 }
234 ;
235
236 element_list1: 
237     #empty
238     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
239 ;
240
241 element_list2: 
242     #empty
243     | 'void' 
244     | base_element { [ $_[1] ] }
245     | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[1] }
246 ;
247
248 array_len: 
249     #empty                        { [] }
250     | '[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
251     | '[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
252 ;
253
254
255 property_list: 
256     #empty
257     | property_list '[' properties ']' { Parse::Pidl::Util::FlattenHash([$_[1],$_[3]]); }
258 ;
259
260 properties: property          { $_[1] }
261     | properties ',' property { Parse::Pidl::Util::FlattenHash([$_[1], $_[3]]); }
262 ;
263
264 property: identifier                   {{ "$_[1]" => "1"     }}
265           | identifier '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
266 ;
267
268 listtext:
269     anytext 
270     | listtext ',' anytext { "$_[1] $_[3]" }
271 ;
272
273 commalisttext:
274     anytext 
275     | commalisttext ',' anytext { "$_[1],$_[3]" }
276 ;
277
278 anytext:  #empty
279     { "" }
280     | identifier | constant | text
281     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
282     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
283     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
284     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
285     | anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
286     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
287     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
288     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
289     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
290     | anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
291     | anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
292     | anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
293 ;
294
295 identifier: IDENTIFIER
296 ;
297
298 optional_identifier: 
299         IDENTIFIER
300    | #empty { undef }
301 ;
302
303 constant: CONSTANT
304 ;
305
306 text: TEXT { "\"$_[1]\"" }
307 ;
308
309 optional_semicolon: 
310         #empty
311         | ';'
312 ;
313
314
315 #####################################
316 # start code
317 %%
318
319 use Parse::Pidl::Util;
320
321 #####################################################################
322 # traverse a perl data structure removing any empty arrays or
323 # hashes and any hash elements that map to undef
324 sub CleanData($)
325 {
326     sub CleanData($);
327     my($v) = shift;
328     if (ref($v) eq "ARRAY") {
329         foreach my $i (0 .. $#{$v}) {
330             CleanData($v->[$i]);
331             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
332                     $v->[$i] = undef; 
333                     next; 
334             }
335         }
336         # this removes any undefined elements from the array
337         @{$v} = grep { defined $_ } @{$v};
338     } elsif (ref($v) eq "HASH") {
339         foreach my $x (keys %{$v}) {
340             CleanData($v->{$x});
341             if (!defined $v->{$x}) { delete($v->{$x}); next; }
342             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
343         }
344     }
345         return $v;
346 }
347
348 sub _Error {
349     if (exists $_[0]->YYData->{ERRMSG}) {
350                 print $_[0]->YYData->{ERRMSG};
351                 delete $_[0]->YYData->{ERRMSG};
352                 return;
353         };
354         my $line = $_[0]->YYData->{LINE};
355         my $last_token = $_[0]->YYData->{LAST_TOKEN};
356         my $file = $_[0]->YYData->{INPUT_FILENAME};
357         
358         print "$file:$line: Syntax error near '$last_token'\n";
359 }
360
361 sub _Lexer($)
362 {
363         my($parser)=shift;
364
365     $parser->YYData->{INPUT} or return('',undef);
366
367 again:
368         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
369
370         for ($parser->YYData->{INPUT}) {
371                 if (/^\#/) {
372                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
373                                 $parser->YYData->{LINE} = $1-1;
374                                 $parser->YYData->{INPUT_FILENAME} = $2;
375                                 goto again;
376                         }
377                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
378                                 $parser->YYData->{LINE} = $1-1;
379                                 $parser->YYData->{INPUT_FILENAME} = $2;
380                                 goto again;
381                         }
382                         if (s/^(\#.*)$//m) {
383                                 goto again;
384                         }
385                 }
386                 if (s/^(\n)//) {
387                         $parser->YYData->{LINE}++;
388                         goto again;
389                 }
390                 if (s/^\"(.*?)\"//) {
391                         $parser->YYData->{LAST_TOKEN} = $1;
392                         return('TEXT',$1); 
393                 }
394                 if (s/^(\d+)(\W|$)/$2/) {
395                         $parser->YYData->{LAST_TOKEN} = $1;
396                         return('CONSTANT',$1); 
397                 }
398                 if (s/^([\w_]+)//) {
399                         $parser->YYData->{LAST_TOKEN} = $1;
400                         if ($1 =~ 
401                             /^(coclass|interface|const|typedef|declare|union
402                               |struct|enum|bitmap|void)$/x) {
403                                 return $1;
404                         }
405                         return('IDENTIFIER',$1);
406                 }
407                 if (s/^(.)//s) {
408                         $parser->YYData->{LAST_TOKEN} = $1;
409                         return($1,$1);
410                 }
411         }
412 }
413
414 sub parse_idl($$)
415 {
416         my ($self,$filename) = @_;
417
418         my $saved_delim = $/;
419         undef $/;
420         my $cpp = $ENV{CPP};
421         if (! defined $cpp) {
422                 $cpp = "cpp"
423         }
424         my $data = `$cpp -D__PIDL__ -xc $filename`;
425         $/ = $saved_delim;
426
427     $self->YYData->{INPUT} = $data;
428     $self->YYData->{LINE} = 0;
429     $self->YYData->{LAST_TOKEN} = "NONE";
430
431         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
432
433         return CleanData($idl);
434 }