samba-mirror/source/pidl/smb_interfaces.yp

########################
# Parse::Yapp parser for a C header file that contains only structures 
# or unions.  

# Copyright (C) 2005, Tim Potter <tpot@samba.org> released under the
# GNU GPL version 2 or later

################
# grammar

%%

definitions:
	definition			{ [$_[1]] }
	| definitions definition	{ push(@{$_[1]}, $_[2]); $_[1] }
;

definition:
	struct 
	| union 
	| typedef 
	| enum
;

struct: STRUCT optional_identifier '{' elements '}' pointers optional_identifiers ';'
	{
		{
			"NAME" => $_[7],
			"STRUCT_NAME" => $_[2],
			"TYPE" => "struct",
			"DATA" => $_[4],
		}
	}
;

union:
	UNION optional_identifier '{' elements '}' pointers optional_identifier ';'
	{
		{
			"NAME" => $_[7],
			"UNION_NAME" => $_[2],
			"TYPE" => "union",
			"DATA" => $_[4],
		}
	}
;

typedef:
	TYPEDEF STRUCT '{' elements '}' optional_identifier ';'
;

enum:
	ENUM IDENTIFIER '{' enum_identifiers '}' ';'
;

enum_identifiers: enum_identifier
	| enum_identifiers ',' enum_identifier
;

enum_identifier: IDENTIFIER
	| IDENTIFIER '=' IDENTIFIER
;

elements: #empty
	| elements element { push(@{$_[1]}, $_[2]); $_[1] }
;

element: 
	| struct
	| union
	| STRUCT IDENTIFIER pointers IDENTIFIER ';'
		{{
			"NAME" => [$_[2]],
			"POINTERS" => $_[3],
			"TYPE" => "struct $_[2]",
		}}
	| UNION IDENTIFIER pointers IDENTIFIER ';'
		{{
			"NAME" => $_[2],
			"POINTERS" => $_[3],
			"TYPE" => "union $_[2]",
		}}
	| CONST type pointers IDENTIFIER array ';'
		{{
			   "NAME" => [$_[4]],
			   "TYPE" => $_[2],
			   "POINTERS" => $_[3],
		}}
	| type pointers IDENTIFIER array ';'
		{{
			   "NAME" => [$_[3]],
			   "TYPE" => $_[1],
			   "POINTERS" => $_[2],
			   "ARRAY_LENGTH" => $_[4]
		}}
;

array: #empty
	| '[' CONSTANT  ']'	{ int($_[2]) }
;

type: IDENTIFIER
	| ENUM IDENTIFIER
		{ "enum $_[2]" }
;

pointers: 
   #empty { 0 }
   | pointers '*'  { $_[1]+1 }
;

optional_identifiers: optional_identifier { [$_[1]] }
	| optional_identifiers ',' optional_identifier { push(@{$_[1]}, $_[3]); $_[1] }
;

optional_identifier: IDENTIFIER | #empty { undef }
;

%%

#####################################################################
# 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;
    if (ref($v) eq "ARRAY") {
	foreach my $i (0 .. $#{$v}) {
	    CleanData($v->[$i]);
	    if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
		    $v->[$i] = undef; 
		    next; 
	    }
	}
	# 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; }
	    if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
	}
    }
	return $v;
}

sub _Error {
    if (exists $_[0]->YYData->{ERRMSG}) {
		print $_[0]->YYData->{ERRMSG};
		delete $_[0]->YYData->{ERRMSG};
		return;
	};
	my $line = $_[0]->YYData->{LINE};
	my $last_token = $_[0]->YYData->{LAST_TOKEN};
	my $file = $_[0]->YYData->{INPUT_FILENAME};
	
	print "$file:$line: Syntax error near '$last_token'\n";
}

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->{INPUT_FILENAME} = $2;
				goto again;
			}
			if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
				$parser->YYData->{LINE} = $1-1;
				$parser->YYData->{INPUT_FILENAME} = $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 =~ 
			    /^(const|typedef|union|struct|enum)$/x) {
				return uc($1);
			}
			return('IDENTIFIER',$1);
		}
		if (s/^(.)//s) {
			$parser->YYData->{LAST_TOKEN} = $1;
			return($1,$1);
		}
	}
}

sub parse($$)
{
	my ($self,$filename) = @_;

	my $saved_delim = $/;
	undef $/;
	my $cpp = $ENV{CPP};
	if (! defined $cpp) {
		$cpp = "cpp"
	}
	my $data = `$cpp -D__PIDL__ -xc $filename`;
	$/ = $saved_delim;

    $self->YYData->{INPUT} = $data;
    $self->YYData->{LINE} = 0;
    $self->YYData->{LAST_TOKEN} = "NONE";

	my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );

	return CleanData($idl);
}