r4533: parsing support for:
[samba.git] / source4 / build / 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 grammer, but
9 # by providing a precedence we reduce the number of conflicts
10 # enormously
11 %left   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
12
13
14 ################
15 # grammer
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 '{' interfaces '}' optional_semicolon
24           {$_[3] => {
25                "TYPE" => "COCLASS", 
26                "PROPERTIES" => $_[1],
27                "NAME" => $_[3],
28                "DATA" => $_[5],
29           }}
30 ;
31
32 interfaces:
33         #empty { {} }
34         | interfaces interface { push(@{$_[1]}, $_[2]); $_[1] }
35 ;
36
37 interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
38           {$_[3] => {
39                "TYPE" => "INTERFACE", 
40                "PROPERTIES" => $_[1],
41                "NAME" => $_[3],
42                "BASE" => $_[4],
43                "DATA" => $_[6],
44           }}
45 ;
46
47 base_interface:
48         #empty
49         | ':' identifier { $_[2] }
50 ;
51
52 definitions: 
53       definition              { [ $_[1] ] }    
54     | definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
55 ;    
56
57
58 definition: function | const | typedef
59 ;
60
61 const: 'const' identifier identifier '=' anytext ';' 
62         {{
63                      "TYPE"  => "CONST", 
64                      "DTYPE"  => $_[2],
65                      "NAME"  => $_[3],
66                      "VALUE" => $_[5]
67         }}
68         | 'const' identifier identifier array_len '=' anytext ';' 
69         {{
70                      "TYPE"  => "CONST", 
71                      "DTYPE"  => $_[2],
72                      "NAME"  => $_[3],
73                      "ARRAY_LEN" => $_[4],
74                      "VALUE" => $_[6],
75         }}
76 ;
77
78
79 function: property_list type identifier '(' element_list2 ')' ';' 
80          {{
81                 "TYPE" => "FUNCTION",
82                 "NAME" => $_[3],
83                 "RETURN_TYPE" => $_[2],
84                 "PROPERTIES" => $_[1],
85                 "DATA" => $_[5]
86          }}
87 ;
88
89 typedef: 'typedef' property_list type identifier array_len ';' 
90         {{
91                      "TYPE" => "TYPEDEF", 
92                      "PROPERTIES" => $_[2],
93                      "NAME" => $_[4],
94                      "DATA" => $_[3],
95                      "ARRAY_LEN" => $_[5]
96         }}
97 ;
98
99 type:   struct | union | enum | bitmap | identifier 
100         | void { "void" }
101 ;
102
103
104 enum: 'enum' '{' enum_elements '}' 
105         {{
106                      "TYPE" => "ENUM", 
107                      "ELEMENTS" => $_[3]
108         }}
109 ;
110
111 enum_elements: 
112       enum_element                    { [ $_[1] ] }            
113     | enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
114 ;
115
116 enum_element: identifier 
117               | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
118 ;
119
120 bitmap: 'bitmap' '{' bitmap_elements '}' 
121         {{
122                      "TYPE" => "BITMAP", 
123                      "ELEMENTS" => $_[3]
124         }}
125 ;
126
127 bitmap_elements: 
128       bitmap_element                    { [ $_[1] ] }            
129     | bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
130 ;
131
132 bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
133 ;
134
135 struct: 'struct' '{' element_list1 '}' 
136         {{
137                      "TYPE" => "STRUCT", 
138                      "ELEMENTS" => $_[3]
139         }}
140 ;
141
142 union: 'union' '{' union_elements '}' 
143          {{
144                 "TYPE" => "UNION",
145                 "DATA" => $_[3]
146          }}
147 ;
148
149 union_elements: 
150       union_element                    { [ $_[1] ] }            
151     | union_elements union_element  { push(@{$_[1]}, $_[2]); $_[1] }
152 ;
153
154 union_element: 
155          '[' 'case' '(' anytext ')' ']' base_element ';'
156          {{
157                 "TYPE" => "UNION_ELEMENT",
158                 "CASE" => $_[4],
159                 "DATA" => $_[7]
160          }}
161          | '[' 'case' '(' anytext ')' ']' ';'
162          {{
163                 "TYPE" => "EMPTY",
164                 "CASE" => $_[4],
165          }}
166          | '[' 'default' ']' base_element ';'
167          {{
168                 "TYPE" => "UNION_ELEMENT",
169                 "CASE" => "default",
170                 "DATA" => $_[4]
171          }}
172          | '[' 'default' ']' ';'
173          {{
174                 "TYPE" => "EMPTY",
175                 "CASE" => "default",
176          }}
177 ;
178
179 base_element: property_list type pointers identifier array_len
180               {{
181                            "NAME" => $_[4],
182                            "TYPE" => $_[2],
183                            "PROPERTIES" => $_[1],
184                            "POINTERS" => $_[3],
185                            "ARRAY_LEN" => $_[5]
186               }}
187 ;
188
189
190 pointers: 
191   #empty            
192    { 0 }
193     | pointers '*'  { $_[1]+1 }
194 ;
195
196
197
198 element_list1: 
199     #empty
200     | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
201 ;
202
203 element_list2: 
204     #empty
205     | 'void' 
206     | base_element { [ $_[1] ] }
207     | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[1] }
208 ;
209
210 array_len: 
211     #empty 
212     | '[' ']'            { "*" }
213     | '[' anytext ']'    { "$_[2]" }
214 ;
215
216
217 property_list: 
218     #empty
219     | property_list '[' properties ']' { util::FlattenHash([$_[1],$_[3]]); }
220 ;
221
222 properties: property          { $_[1] }
223     | properties ',' property { util::FlattenHash([$_[1], $_[3]]); }
224 ;
225
226 property: identifier                   {{ "$_[1]" => "1"     }}
227           | identifier '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
228 ;
229
230 listtext:
231     anytext 
232     | listtext ',' anytext { "$_[1] $_[3]" }
233 ;
234
235 commalisttext:
236     anytext 
237     | commalisttext ',' anytext { "$_[1],$_[3]" }
238 ;
239
240 anytext:  #empty
241     { "" }
242     | identifier | constant | text
243     | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
244     | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
245     | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
246     | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
247     | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
248     | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
249     | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
250     | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
251     | anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
252     | anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
253 ;
254
255 identifier: IDENTIFIER
256 ;
257
258 constant: CONSTANT
259 ;
260
261 text: TEXT { "\"$_[1]\"" }
262 ;
263
264 optional_semicolon: 
265         #empty
266         | ';'
267 ;
268
269
270 #####################################
271 # start code
272 %%
273
274 use util;
275
276 sub _Error {
277         if (exists $_[0]->YYData->{ERRMSG}) {
278                 print $_[0]->YYData->{ERRMSG};
279                 delete $_[0]->YYData->{ERRMSG};
280                 return;
281         };
282         my $line = $_[0]->YYData->{LINE};
283         my $last_token = $_[0]->YYData->{LAST_TOKEN};
284         my $file = $_[0]->YYData->{INPUT_FILENAME};
285         
286         print "$file:$line: Syntax error near '$last_token'\n";
287 }
288
289 sub _Lexer($)
290 {
291         my($parser)=shift;
292
293         $parser->YYData->{INPUT}
294         or  return('',undef);
295
296 again:
297         $parser->YYData->{INPUT} =~ s/^[ \t]*//;
298
299         for ($parser->YYData->{INPUT}) {
300                 if (/^\#/) {
301                         if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
302                                 $parser->YYData->{LINE} = $1-1;
303                                 $parser->YYData->{INPUT_FILENAME} = $2;
304                                 goto again;
305                         }
306                         if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
307                                 $parser->YYData->{LINE} = $1-1;
308                                 $parser->YYData->{INPUT_FILENAME} = $2;
309                                 goto again;
310                         }
311                         if (s/^(\#.*)$//m) {
312                                 goto again;
313                         }
314                 }
315                 if (s/^(\n)//) {
316                         $parser->YYData->{LINE}++;
317                         goto again;
318                 }
319                 if (s/^\"(.*?)\"//) {
320                         $parser->YYData->{LAST_TOKEN} = $1;
321                         return('TEXT',$1); 
322                 }
323                 if (s/^(\d+)(\W|$)/$2/) {
324                         $parser->YYData->{LAST_TOKEN} = $1;
325                         return('CONSTANT',$1); 
326                 }
327                 if (s/^([\w_]+)//) {
328                         $parser->YYData->{LAST_TOKEN} = $1;
329                         if ($1 =~ 
330                             /^(coclass|interface|const|typedef|union
331                               |struct|enum|bitmap|void|case|default)$/x) {
332                                 return $1;
333                         }
334                         return('IDENTIFIER',$1);
335                 }
336                 if (s/^(.)//s) {
337                         $parser->YYData->{LAST_TOKEN} = $1;
338                         return($1,$1);
339                 }
340         }
341 }
342
343 sub parse_idl($$)
344 {
345         my $self = shift;
346         my $filename = shift;
347
348         my $saved_delim = $/;
349         undef $/;
350         my $cpp = $ENV{CPP};
351         if (! defined $cpp) {
352                 $cpp = "cpp"
353         }
354         my $data = `$cpp -xc $filename`;
355         $/ = $saved_delim;
356
357     $self->YYData->{INPUT} = $data;
358     $self->YYData->{LINE} = 0;
359     $self->YYData->{LAST_TOKEN} = "NONE";
360
361         my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
362
363         foreach my $x (@{$idl}) {
364                 # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
365                 # for 'object' interfaces
366                 if (defined($x->{PROPERTIES}->{object})) {
367                         foreach my $e (@{$x->{DATA}}) {
368                                 if($e->{TYPE} eq "FUNCTION") {
369                                         $e->{PROPERTIES}->{object} = 1;
370                                         unshift(@{$e->{DATA}}, 
371                         { 'NAME' => 'ORPCthis',
372                           'POINTERS' => 0,
373                           'PROPERTIES' => { 'in' => '1' },
374                           'TYPE' => 'ORPCTHIS'
375                         });
376                                         unshift(@{$e->{DATA}},
377                         { 'NAME' => 'ORPCthat',
378                           'POINTERS' => 0,
379                           'PROPERTIES' => { 'out' => '1' },
380                                                   'TYPE' => 'ORPCTHAT'
381                         });
382                                 }
383                         }
384                 }
385                 
386                 # Do the inheritance
387                 if (defined($x->{BASE}) and $x->{BASE} ne "") {
388                         my $parent = util::get_interface($idl, $x->{BASE});
389
390                         if(not defined($parent)) { 
391                                 die("No such parent interface " . $x->{BASE});
392                         }
393                         
394                         @{$x->{INHERITED_DATA}} = (@{$parent->{INHERITED_DATA}}, @{$x->{DATA}});
395                 } else {
396                         $x->{INHERITED_DATA} = $x->{DATA};
397                 }
398         }
399
400         return $idl;
401 }