######################## # IDL Parse::Yapp parser # Copyright (C) Andrew Tridgell <tridge@samba.org> # released under the GNU GPL version 3 or later # the precedence actually doesn't matter at all for this grammar, but # by providing a precedence we reduce the number of conflicts # enormously %left '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';' ################ # grammar %% idl: #empty { {} } | idl interface { push(@{$_[1]}, $_[2]); $_[1] } | idl coclass { push(@{$_[1]}, $_[2]); $_[1] } | idl import { push(@{$_[1]}, $_[2]); $_[1] } | idl include { push(@{$_[1]}, $_[2]); $_[1] } | idl importlib { push(@{$_[1]}, $_[2]); $_[1] } | idl cpp_quote { push(@{$_[1]}, $_[2]); $_[1] } ; import: 'import' commalist ';' {{ "TYPE" => "IMPORT", "PATHS" => $_[2], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; include: 'include' commalist ';' {{ "TYPE" => "INCLUDE", "PATHS" => $_[2], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; importlib: 'importlib' commalist ';' {{ "TYPE" => "IMPORTLIB", "PATHS" => $_[2], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; commalist: text { [ $_[1] ] } | commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] } ; coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon {{ "TYPE" => "COCLASS", "PROPERTIES" => $_[1], "NAME" => $_[3], "DATA" => $_[5], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; interface_names: #empty { {} } | interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] } ; interface: property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon {{ "TYPE" => "INTERFACE", "PROPERTIES" => $_[1], "NAME" => $_[3], "BASE" => $_[4], "DATA" => $_[6], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; base_interface: #empty | ':' identifier { $_[2] } ; cpp_quote: 'cpp_quote' '(' text ')' {{ "TYPE" => "CPP_QUOTE", "DATA" => $_[3], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; definitions: definition { [ $_[1] ] } | definitions definition { push(@{$_[1]}, $_[2]); $_[1] } ; definition: function | const | typedef | typedecl ; const: 'const' identifier pointers identifier '=' anytext ';' {{ "TYPE" => "CONST", "DTYPE" => $_[2], "POINTERS" => $_[3], "NAME" => $_[4], "VALUE" => $_[6], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} | 'const' identifier pointers identifier array_len '=' anytext ';' {{ "TYPE" => "CONST", "DTYPE" => $_[2], "POINTERS" => $_[3], "NAME" => $_[4], "ARRAY_LEN" => $_[5], "VALUE" => $_[7], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; function: property_list type identifier '(' element_list2 ')' ';' {{ "TYPE" => "FUNCTION", "NAME" => $_[3], "RETURN_TYPE" => $_[2], "PROPERTIES" => $_[1], "ELEMENTS" => $_[5], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; typedef: property_list 'typedef' type identifier array_len ';' {{ "TYPE" => "TYPEDEF", "PROPERTIES" => $_[1], "NAME" => $_[4], "DATA" => $_[3], "ARRAY_LEN" => $_[5], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; usertype: struct | union | enum | bitmap | pipe ; typedecl: usertype ';' { $_[1] } ; sign: 'signed' | 'unsigned' ; existingtype: sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" } | identifier ; type: usertype | existingtype | void { "void" } ; enum_body: '{' enum_elements '}' { $_[2] } ; opt_enum_body: #empty | enum_body ; enum: property_list 'enum' optional_identifier opt_enum_body {{ "TYPE" => "ENUM", "PROPERTIES" => $_[1], "NAME" => $_[3], "ELEMENTS" => $_[4], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; enum_elements: enum_element { [ $_[1] ] } | enum_elements ',' enum_element { push(@{$_[1]}, $_[3]); $_[1] } ; enum_element: identifier | identifier '=' anytext { "$_[1]$_[2]$_[3]" } ; bitmap_body: '{' opt_bitmap_elements '}' { $_[2] } ; opt_bitmap_body: #empty | bitmap_body ; bitmap: property_list 'bitmap' optional_identifier opt_bitmap_body {{ "TYPE" => "BITMAP", "PROPERTIES" => $_[1], "NAME" => $_[3], "ELEMENTS" => $_[4], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; bitmap_elements: bitmap_element { [ $_[1] ] } | bitmap_elements ',' bitmap_element { push(@{$_[1]}, $_[3]); $_[1] } ; opt_bitmap_elements: #empty | bitmap_elements ; bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" } ; struct_body: '{' element_list1 '}' { $_[2] } ; opt_struct_body: #empty | struct_body ; struct: property_list 'struct' optional_identifier opt_struct_body {{ "TYPE" => "STRUCT", "PROPERTIES" => $_[1], "NAME" => $_[3], "ELEMENTS" => $_[4], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; empty_element: property_list ';' {{ "NAME" => "", "TYPE" => "EMPTY", "PROPERTIES" => $_[1], "POINTERS" => 0, "ARRAY_LEN" => [], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; base_or_empty: base_element ';' | empty_element; optional_base_element: property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] } ; union_elements: #empty | union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] } ; union_body: '{' union_elements '}' { $_[2] } ; opt_union_body: #empty | union_body ; union: property_list 'union' optional_identifier opt_union_body {{ "TYPE" => "UNION", "PROPERTIES" => $_[1], "NAME" => $_[3], "ELEMENTS" => $_[4], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; base_element: property_list type pointers identifier array_len {{ "NAME" => $_[4], "TYPE" => $_[2], "PROPERTIES" => $_[1], "POINTERS" => $_[3], "ARRAY_LEN" => $_[5], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; pointers: #empty { 0 } | pointers '*' { $_[1]+1 } ; pipe: property_list 'pipe' type {{ "TYPE" => "PIPE", "PROPERTIES" => $_[1], "DATA" => $_[3], "FILE" => $_[0]->YYData->{FILE}, "LINE" => $_[0]->YYData->{LINE}, }} ; element_list1: #empty { [] } | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] } ; optional_const: #empty | 'const' ; element_list2: #empty | 'void' | optional_const base_element { [ $_[2] ] } | element_list2 ',' optional_const base_element { push(@{$_[1]}, $_[4]); $_[1] } ; array_len: #empty { [] } | '[' ']' array_len { push(@{$_[3]}, "*"); $_[3] } | '[' anytext ']' array_len { push(@{$_[4]}, "$_[2]"); $_[4] } ; property_list: #empty | property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); } ; properties: property { $_[1] } | properties ',' property { FlattenHash([$_[1], $_[3]]); } ; property: identifier {{ "$_[1]" => "1" }} | identifier '(' commalisttext ')' {{ "$_[1]" => "$_[3]" }} ; commalisttext: anytext | commalisttext ',' anytext { "$_[1],$_[3]" } ; anytext: #empty { "" } | identifier | constant | text | anytext '-' anytext { "$_[1]$_[2]$_[3]" } | anytext '.' anytext { "$_[1]$_[2]$_[3]" } | anytext '*' anytext { "$_[1]$_[2]$_[3]" } | anytext '>' anytext { "$_[1]$_[2]$_[3]" } | anytext '<' anytext { "$_[1]$_[2]$_[3]" } | anytext '|' anytext { "$_[1]$_[2]$_[3]" } | anytext '&' anytext { "$_[1]$_[2]$_[3]" } | anytext '/' anytext { "$_[1]$_[2]$_[3]" } | anytext '?' anytext { "$_[1]$_[2]$_[3]" } | anytext ':' anytext { "$_[1]$_[2]$_[3]" } | anytext '=' anytext { "$_[1]$_[2]$_[3]" } | anytext '+' anytext { "$_[1]$_[2]$_[3]" } | anytext '~' anytext { "$_[1]$_[2]$_[3]" } | anytext '(' commalisttext ')' anytext { "$_[1]$_[2]$_[3]$_[4]$_[5]" } | anytext '{' commalisttext '}' anytext { "$_[1]$_[2]$_[3]$_[4]$_[5]" } ; identifier: IDENTIFIER ; optional_identifier: #empty { undef } | IDENTIFIER ; constant: CONSTANT ; text: TEXT { "\"$_[1]\"" } ; optional_semicolon: #empty | ';' ; ##################################### # start code %% use Parse::Pidl qw(error); ##################################################################### # flatten an array of hashes into a single hash sub FlattenHash($) { my $a = shift; my %b; for my $d (@{$a}) { for my $k (keys %{$d}) { $b{$k} = $d->{$k}; } } return \%b; } ##################################################################### # traverse a perl data structure removing any empty arrays or # hashes and any hash elements that map to undef sub CleanData($) { sub CleanData($); my($v) = shift; return undef if (not defined($v)); if (ref($v) eq "ARRAY") { foreach my $i (0 .. $#{$v}) { CleanData($v->[$i]); } # this removes any undefined elements from the array @{$v} = grep { defined $_ } @{$v}; } elsif (ref($v) eq "HASH") { foreach my $x (keys %{$v}) { CleanData($v->{$x}); if (!defined $v->{$x}) { delete($v->{$x}); next; } } } return $v; } sub _Error { if (exists $_[0]->YYData->{ERRMSG}) { error($_[0]->YYData, $_[0]->YYData->{ERRMSG}); delete $_[0]->YYData->{ERRMSG}; return; } my $last_token = $_[0]->YYData->{LAST_TOKEN}; error($_[0]->YYData, "Syntax error near '$last_token'"); } sub _Lexer($) { my($parser)=shift; $parser->YYData->{INPUT} or return('',undef); again: $parser->YYData->{INPUT} =~ s/^[ \t]*//; for ($parser->YYData->{INPUT}) { if (/^\#/) { if (s/^\# (\d+) \"(.*?)\"( \d+|)//) { $parser->YYData->{LINE} = $1-1; $parser->YYData->{FILE} = $2; goto again; } if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) { $parser->YYData->{LINE} = $1-1; $parser->YYData->{FILE} = $2; goto again; } if (s/^(\#.*)$//m) { goto again; } } if (s/^(\n)//) { $parser->YYData->{LINE}++; goto again; } if (s/^\"(.*?)\"//) { $parser->YYData->{LAST_TOKEN} = $1; return('TEXT',$1); } if (s/^(\d+)(\W|$)/$2/) { $parser->YYData->{LAST_TOKEN} = $1; return('CONSTANT',$1); } if (s/^([\w_]+)//) { $parser->YYData->{LAST_TOKEN} = $1; if ($1 =~ /^(coclass|interface|import|importlib |include|cpp_quote|typedef |union|struct|enum|bitmap|pipe |void|const|unsigned|signed)$/x) { return $1; } return('IDENTIFIER',$1); } if (s/^(.)//s) { $parser->YYData->{LAST_TOKEN} = $1; return($1,$1); } } } sub parse_string { my ($data,$filename) = @_; my $self = new Parse::Pidl::IDL; $self->YYData->{FILE} = $filename; $self->YYData->{INPUT} = $data; $self->YYData->{LINE} = 0; $self->YYData->{LAST_TOKEN} = "NONE"; my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error ); return CleanData($idl); } sub parse_file($$) { my ($filename,$incdirs) = @_; my $saved_delim = $/; undef $/; my $cpp = $ENV{CPP}; if (! defined $cpp) { $cpp = "cpp"; } my $includes = join('',map { " -I$_" } @$incdirs); my $data = `$cpp -D__PIDL__$includes -xc $filename`; $/ = $saved_delim; return parse_string($data, $filename); }