idl.yp - metacpan.org

########################
# IDL Parse::Yapp parser
# Copyright (C) Andrew Tridgell <tridge@samba.org>
# released under the GNU GPL version 2 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] }
;

coclass: property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
          {$_[3] => {
               "TYPE" => "COCLASS", 
	       "PROPERTIES" => $_[1],
	       "NAME" => $_[3],
	       "DATA" => $_[5],
		   "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		   "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
          {$_[3] => {
               "TYPE" => "INTERFACE", 
	       "PROPERTIES" => $_[1],
	       "NAME" => $_[3],
	       "BASE" => $_[4],
	       "DATA" => $_[6],
		   "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		   "LINE" => $_[0]->YYData->{LINE},
          }}
;

base_interface:
	#empty
	| ':' identifier { $_[2] }
;

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


definition: function | const | typedef | declare | typedecl
;

const: 'const' identifier pointers identifier '=' anytext ';' 
        {{
                     "TYPE"  => "CONST", 
		     "DTYPE"  => $_[2],
			 "POINTERS" => $_[3],
		     "NAME"  => $_[4],
		     "VALUE" => $_[6],
		     "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		     "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->{INPUT_FILENAME},
		     "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->{INPUT_FILENAME},
		"LINE" => $_[0]->YYData->{LINE},
	  }}
;

declare: 'declare' property_list decl_type identifier';' 
        {{
	             "TYPE" => "DECLARE", 
                     "PROPERTIES" => $_[2],
		     "NAME" => $_[4],
		     "DATA" => $_[3],
		     "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		     "LINE" => $_[0]->YYData->{LINE},
        }}
;

decl_type: decl_enum | decl_bitmap
;

decl_enum: 'enum' 
        {{
                     "TYPE" => "ENUM"
        }}
;

decl_bitmap: 'bitmap' 
        {{
                     "TYPE" => "BITMAP"
        }}
;

typedef: 'typedef' property_list type identifier array_len ';' 
        {{
	             "TYPE" => "TYPEDEF", 
                     "PROPERTIES" => $_[2],
		     "NAME" => $_[4],
		     "DATA" => $_[3],
		     "ARRAY_LEN" => $_[5],
		     "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		     "LINE" => $_[0]->YYData->{LINE},
        }}
;

usertype: struct | union | enum | bitmap;

typedecl: usertype ';' { $_[1] };

sign: 'signed' | 'unsigned';

existingtype: 
	| sign identifier { "$_[1] $_[2]" }
	| identifier 
;

type: usertype | existingtype | void { "void" } ;

enum_body: '{' enum_elements '}' { $_[2] };
opt_enum_body: | enum_body;
enum: 'enum' optional_identifier opt_enum_body
        {{
             "TYPE" => "ENUM", 
			 "NAME" => $_[2],
		     "ELEMENTS" => $_[3]
        }}
;

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

enum_element: identifier 
	      | identifier '=' anytext { "$_[1]$_[2]$_[3]" }
;

bitmap_body: '{' bitmap_elements '}' { $_[2] };
opt_bitmap_body: | bitmap_body;
bitmap: 'bitmap' optional_identifier opt_bitmap_body
        {{
             "TYPE" => "BITMAP", 
			 "NAME" => $_[2],
		     "ELEMENTS" => $_[3]
        }}
;

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

bitmap_element: identifier '=' anytext { "$_[1] ( $_[3] )" }
;

struct_body: '{' element_list1 '}' { $_[2] };
opt_struct_body: | struct_body;

struct: 'struct' optional_identifier opt_struct_body
        {{
             "TYPE" => "STRUCT", 
			 "NAME" => $_[2],
		     "ELEMENTS" => $_[3]
        }}
;

empty_element: property_list ';'
	{{
		 "NAME" => "",
		 "TYPE" => "EMPTY",
		 "PROPERTIES" => $_[1],
		 "POINTERS" => 0,
		 "ARRAY_LEN" => [],
		 "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		 "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: 'union' optional_identifier opt_union_body
        {{
             "TYPE" => "UNION", 
		     "NAME" => $_[2],
		     "ELEMENTS" => $_[3]
        }}
;

base_element: property_list type pointers identifier array_len
	      {{
			   "NAME" => $_[4],
			   "TYPE" => $_[2],
			   "PROPERTIES" => $_[1],
			   "POINTERS" => $_[3],
			   "ARRAY_LEN" => $_[5],
		       "FILE" => $_[0]->YYData->{INPUT_FILENAME},
		       "LINE" => $_[0]->YYData->{LINE},
              }}
;


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

element_list1: 
    #empty
    | element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
;

element_list2: 
    #empty
    | 'void' 
    | base_element { [ $_[1] ] }
    | element_list2 ',' base_element { push(@{$_[1]}, $_[3]); $_[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 '(' listtext ')' {{ "$_[1]" => "$_[3]" }}
;

listtext:
    anytext 
    | listtext ',' anytext { "$_[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
%%

#####################################################################
# 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]);
	    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 =~ 
			    /^(coclass|interface|const|typedef|declare|union
			      |struct|enum|bitmap|void|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->{INPUT_FILENAME} = $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) = @_;

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

	return parse_string($data, $filename);
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)