samba-mirror/pidl/idl.yp

########################
# 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);
}