+++ /dev/null
-########################
-# 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",
- "FILE" => $_[0]->YYData->{FILE},
- "LINE" => $_[0]->YYData->{LINE},
- "DATA" => $_[3]
- }}
-;
-
-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;
-
-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: | enum_body;
-enum: property_list 'enum' optional_identifier opt_enum_body
- {{
- "TYPE" => "ENUM",
- "PROPERTIES" => $_[1],
- "NAME" => $_[3],
- "ELEMENTS" => $_[4]
- }}
-;
-
-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: | bitmap_body;
-bitmap: property_list 'bitmap' optional_identifier opt_bitmap_body
- {{
- "TYPE" => "BITMAP",
- "PROPERTIES" => $_[1],
- "NAME" => $_[3],
- "ELEMENTS" => $_[4]
- }}
-;
-
-bitmap_elements:
- bitmap_element { [ $_[1] ] }
- | bitmap_elements ',' bitmap_element { push(@{$_[1]}, $_[3]); $_[1] }
-;
-
-opt_bitmap_elements: | bitmap_elements;
-
-bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
-;
-
-struct_body: '{' element_list1 '}' { $_[2] };
-opt_struct_body: | struct_body;
-
-struct: property_list 'struct' optional_identifier opt_struct_body
- {{
- "TYPE" => "STRUCT",
- "PROPERTIES" => $_[1],
- "NAME" => $_[3],
- "ELEMENTS" => $_[4]
- }}
-;
-
-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: | union_body;
-
-union: property_list 'union' optional_identifier opt_union_body
- {{
- "TYPE" => "UNION",
- "PROPERTIES" => $_[1],
- "NAME" => $_[3],
- "ELEMENTS" => $_[4]
- }}
-;
-
-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 }
-;
-
-element_list1:
- { [] }
- | 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:
- IDENTIFIER
- | #empty { undef }
-;
-
-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|const|typedef|union|cpp_quote
- |struct|enum|bitmap|void|unsigned|signed|import|include
- |importlib)$/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);
-}
git.samba.org / samba.git / blobdiff