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