parser.pm

這是一個VHDL的parser目前版本為0.12

#
# temporary patch, don't allow function calls without a parameter list
#  in parenthesis. this will prevent identifiers from being mistaken
#  for function calls with no parameters.
#
# this means that functions with no parameters will be mistaken
# for identifiers. at least until this is fixed somehow.
#
function_call : 
	function_name 
	subprogram_parameter_section	#(?) 

expression_rule_in_parens : 
	'(' expression_rule ')'

# left recursion here.
# name = ( name | functionname) ... | (name | functioncall) 
# need to clean up "name" rule declaration
name :
	  attribute_name 
	| operator_symbol 
	| selected_name 
	| identifier_paren_one_or_expression_rule_comma_expression_rule
	| identifier_paren_discrete_range
	| identifier

identifier_paren_one_or_expression_rule_comma_expression_rule : 
	identifier '(' expression_rule_comma_expression_rule ')'

expression_rule_comma_expression_rule :
	expression_rule
	comma_expression_rule(s?)

comma_expression_rule :
	','
	expression_rule

identifier_paren_discrete_range : 
	identifier '(' discrete_range ')'

selected_name :
	identifier  '.' 
	( identifier  '.' )(?)
	reserved_word_all_or_identifier_or_character_literal_or_operator_symbol

reserved_word_all_or_identifier_or_character_literal_or_operator_symbol :
	reserved_word_all | identifier_or_character_literal_or_operator_symbol

operator_symbol :
	'"' graphic_character '"'

attribute_name :
	identifier "'" identifier 

signature :
	'[' 
	type_mark_comma_type_mark(?)  
	reserved_word_return_and_type_mark(?)
	']'

type_mark_comma_type_mark :
	type_mark
	comma_type_mark(s?)

comma_type_mark :
	','
	type_mark

reserved_word_return_and_type_mark :
	reserved_word_return 
	type_mark

literal :
	  reserved_word_null
	| character_literal
	| string_literal 
	| bit_string_literal 
	| based_literal_unit_name
	| decimal_literal_unit_name

character_literal :
	"'" graphic_character "'" 

string_literal :
	'"' graphic_character(s) '"'

bit_string_literal :
	b_or_o_or_x '"' based_integer '"'

b_or_o_or_x :
	'B' | 'O' | 'X'

decimal_literal_unit_name : 
	integer
	optional_fractional_part(?)
	optional_sci_notation(?)
	unit_name(?)

based_literal_unit_name :
	integer 
	'#' 
	based_integer optional_based_fraction_part(?) 
	'#' 
	optional_based_sci_notation(?)
	unit_name(?)


optional_fractional_part :
	  '.' integer

optional_sci_notation :
	 'E' sign(?) integer

optional_based_fraction_part :
	'.' based_integer 

optional_based_sci_notation :
	'E' sign(?) integer

integer :
	/\d+/

based_integer :
	/[A-Za-z0-9][A-Za-z0-9_]/


aggregate :
	'(' choice_expression_comma_choice_expression ')' 

choice_expression_comma_choice_expression :
	optional_choice_arrow_with_expression
	comma_optional_choice_arrow_with_expression(s?)

comma_optional_choice_arrow_with_expression :
	','
	optional_choice_arrow_with_expression

optional_choice_arrow_with_expression :
	optional_choice_arrow(?)
	expression_rule 

optional_choice_arrow :
	choices_pipe_choices '=>'

choices_pipe_choices :
	one_of_several_choices
	pipe_one_of_several_choices(s?)

pipe_one_of_several_choices :
	'|'
	one_of_several_choices

one_of_several_choices :
	reserved_word_others | simple_expression | discrete_range | identifier  

case_label : identifier
loop_label : identifier
if_label : identifier
label : identifier

identifier : /[A-Za-z][A-Za-z_0-9]*/ 


####
#### this needs some polish, need to disable whitespace
#### so that can accept a string literal of " " as valid
####
graphic_character :
	
	/[ A-Za-z0-9\-~`!@#$%^&*()_+={};:',.<>|]/
####################################################
# misc
####################################################
identifier_comma_identifier : 
	identifier
	comma_identifier(s?)

comma_identifier :
	','
	identifier

entity_name : identifier 

####
# generics
####
generic_declaration_section : 
	reserved_word_generic generic_interface_list(?) ';'
	| <error>

generic_interface_list : 
	'('
	 generic_interface_list_entry_semicolon_generic_interface_list_entry
	')' 
	| <error>

generic_interface_list_entry_semicolon_generic_interface_list_entry :
	generic_interface_list_entry
	semicolon_generic_interface_list_entry(s?)
	| <error>

semicolon_generic_interface_list_entry :
	';'
	generic_interface_list_entry
	| <error>

generic_interface_list_entry : 
	identifier_comma_identifier ':'
	subtype_indication 
	default_value(?) 
	| <error>

default_value : 
	':=' static_expression

generic_map_section : 
	reserved_word_generic 
	reserved_word_map 
	optional_generic_association_list(?)   
	| <error>

optional_generic_association_list :
	'(' generic_association_list ')' 
	| <error>

generic_association_list : 
	association_list 
	| <error>


####
# ports
####
port_declaration_section : 
	reserved_word_port 
	port_interface_list(?) ';'
	| <error>

port_interface_list : 
	'('
 	port_interface_list_entry_semicolon_port_interface_list_entry
	 ')' 
	| <error>

port_interface_list_entry_semicolon_port_interface_list_entry :
	port_interface_list_entry
	semicolon_port_interface_list_entry(s?)
	| <error>

semicolon_port_interface_list_entry :
	';'
	port_interface_list_entry
		| <error>

port_interface_list_entry : 
	port_name_comma_port_name 
	':'
	mode
	subtype_indication 
	default_value(?)  
	| <error>

port_name_comma_port_name :
	port_name
	comma_port_name(s?)
	| <error>

comma_port_name :
	','
	port_name

port_map_section : 
	reserved_word_port 
	reserved_word_map 
	optional_port_association_list(?)   
	| <error>

optional_port_association_list :
	'(' port_association_list ')' 
	| <error>

port_association_list : 
	association_list 
	| <error>


####
# parameters to procedure/function call
####
subprogram_parameter_section : 
	'(' parameter_association_list ')' 
	| <error>

parameter_association_list :
	association_list 
	| <error>

####
# instance labels
####

instantiation_label : identifier 

####
# signals
####
signal_name_comma_signal_name :
	signal_name
	comma_signal_name(s?)

comma_signal_name :
	','
	signal_name

signal_name : identifier


digit :
	/[0-9]/



########################################################
# oddball rules, need to confirm correctness
########################################################
procedure_name : identifier
function_name : identifier 
component_name : identifier 
architecture_name : identifier
configuration_name : identifier 
architecture_identifier : identifier
variable_name : identifier
generic_name : identifier
port_name : identifier
parameter_name : identifier
process_label : identifier
group_template_name : identifier
block_label : identifier
type_name : identifier
subtype_name : identifier
generate_label : identifier
resolution_function_name : identifier 
physical_literal : identifier

range_attribute_name : attribute_name

guard_expression : expression_rule
value_expression : expression_rule 
string_expression : expression_rule
time_expression : expression_rule 
file_open_kind_expression : expression_rule

static_expression : identifier

element_subtype_indication : subtype_indication

time_units : 
	'fs' | 'ps' | 'ns' | 'us' | 'ms' | 'sec' | 'min' | 'hr'


# given:
# (1 downto 0)
# 
# the '1 downto' gets confused as a decimal_literal_unit_name
# where 'downto' is the unit_name.
#
# unit_name is generally just an identifier, but to keep
# 'to' or 'downto' or similar confusions,
# unit_name will need to know the valid units available.
#
unit_name : time_units

#END_OF_GRAMMAR

	};   # end of return statement


} #end of sub grammar

#########################################################################
sub decomment_given_text
#########################################################################
{
 my ($obj,$text)=@_;

 my $filtered_text='';

 my $state = 'code';

 my ( $string_prior_to_comment, $string_after_comment);
 my ( $string_prior_to_quote, $string_after_quote);
 my ( $comment_string, $string_after_comment_string);
 my ( $quoted_string, $string_after_quoted_string);

 my $index_to_comment=0;
 my $index_to_quote =0;

 while (1)
  {
  if ($state eq 'code')
	{

	unless ( ($text =~ /--/) or ($text =~ /\"/) )
		{ 
		$filtered_text .= $text ;
		last;
		}


	# look for comment or quoted string
	( $string_prior_to_comment, $string_after_comment)
		= split( /--/ , $text, 2 );

	( $string_prior_to_quote, $string_after_quote)
		= split( /\"/ , $text, 2 );

	$index_to_comment = length($string_prior_to_comment);
	$index_to_quote   = length($string_prior_to_quote  );


	if($index_to_quote < $index_to_comment)
		{
		$state = 'quote'; 
		$filtered_text .= $string_prior_to_quote;
		$text =  $string_after_quote;
		$filtered_text .= '"' ;
		}
	else
		{ 
		$state = 'comment';
		$filtered_text .= $string_prior_to_comment;
		$text = '--' . $string_after_comment;
		}
	}

  elsif ($state eq 'comment')
	{
	# strip out everything from here to the next \n charater
	( $comment_string, $string_after_comment_string)
		= split( /\n/ , $text, 2  );

	$text = "\n" . $string_after_comment_string;

	$state = 'code';
	}

  elsif ($state eq 'quote')
	{
	# get the text until the next quote mark and keep it as a string
	( $quoted_string, $string_after_quoted_string)
		= split( /"/ , $text, 2  );

	$filtered_text .= $quoted_string . '"' ;
	$text =  $string_after_quoted_string;

	$state = 'code';
	}
  }

 ###################
 # make everything lower case, VHDL identifiers are case insensitive
 ###################
 ### $filtered_text = lc($filtered_text);  
  ## well, maybe this isn't such a good solution after all.

 return $filtered_text;

}


#########################################################################
sub Filename
#########################################################################
{
 my $obj = shift;

 while(@_)
	{
	my $filename = shift;
 	my $text = $obj->filename_to_text($filename);
 	$text = $obj->decomment_given_text($text);
 	$obj->design_file($text);
	}
}

#########################################################################
sub filename_to_text
#########################################################################
{
 my ($obj,$filename)=@_;
 open (FILE, $filename) or die "Cannot open $filename for read\n";
 my $text;
 while(<FILE>)
  {
  $text .= $_;
  }
 return $text;
}


#########################################################################
#########################################################################
#########################################################################
#########################################################################
#########################################################################
1;
__END__
#########################################################################
#########################################################################
#########################################################################
#########################################################################
#########################################################################
#########################################################################
#########################################################################

=head1 NAME

Hardware::Vhdl::Parser - A complete grammar for parsing VHDL code using perl

=head1 SYNOPSIS

  use Hardware::Vhdl::Parser;
  $parser = new Hardware::Vhdl::Parser;

  $parser->Filename(@ARGV);

=head1 DESCRIPTION


This module defines the complete grammar needed to parse any VHDL code.
By overloading this grammar, it is possible to easily create perl scripts
which run through VHDL code and perform specific functions.

For example, a Hierarchy.pm uses Hardware::Vhdl::Parser to overload the
grammar rule for component instantiations. This single modification
will print out all instance names that occur in the file being parsed.
This might be useful for creating an automatic build script, or a graphical
hierarchical browser of a VHDL design.

This module is currently in Beta release. All code is subject to change.
Bug reports are welcome.



DSLI information:


D - Development Stage

	a - alpha testing

S - Support Level

	d - developer

L - Language used

	p - perl only, no compiler needed, should be platform independent

I - Interface Style

	O - Object oriented using blessed references and / or inheritance




=head1 AUTHOR


Copyright (C) 2000 Greg London   All Rights Reserved.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

email contact: [e-mail]

=head1 SEE ALSO

Parse::RecDescent version 1.77

perl(1).


=cut