Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Beautification Script - Regular Expressions 2

Status
Not open for further replies.

DrFuzzy

Programmer
Mar 23, 2008
16
GR
Hi all,

I am working on a VHDL code beautifier with Perl. I've come to this part of the beautification process and I got really stuck. Assume for example the following piece of VHDl code:

Code:
entity JK_FF is
  port( clock : in std_logic;
        J, K : in std_logic;
        reset : in std_logic;
        Q, Qbar : out std_logic);
end JK_FF;

Well I'm trying to figure out the regular expressions to transform it to that:

Code:
entity JK_FF is
  port( clock : in  std_logic;
        J     : in  std_logic;
        K     : in  std_logic;
        reset : in  std_logic;
        Q     : out std_logic;
        Qbar  : out std_logic);
end JK_FF;

Hence, briefly,
i. Place all words between 'port(' and ');' in columns.
ii. Separate
<signal_name_1>, <signal_name_2>,...,<signal_name_n> : <direction> <type>;

to

<signal_name_1> : <direction> <type>;
<signal_name_2> : <direction> <type>;
...
<signal_name_n> : <direction> <type>;

Any help, suggestion is more than welcomed

Thanks in advance!


 
I've tried this so far:

Code:
use strict; 
#use warnings;

my @data;
#push @data, [split (/\s+/, $_)] for <DATA>;
push @data, [split (' ', $_)] for <DATA>;

foreach my $row(0..8) {
foreach my $col(0..(@data-1)) {
printf("%-15s", $data[$row][$col]);
}
print "\n";
}

__DATA__
clk         : in std_logic;
areset        : in std_logic;
busy : out std_logic;
writeEnable : in std_logic;
readEnable : in std_logic;
write	: in std_logic_vector(wordSize-1 downto 0);
read	: out std_logic_vector(wordSize-1 downto 0);
addr : in std_logic_vector(maxAddrBit downto minAddrBit));

eventhough <wordSize-1 downto> has a space separator, for some reason I get this:

write : in std_logic_vector(wordSize-1downto 0);

Any ideas?

 
See if this helps.
Code:
my $short_record = '  %6s %-12s : %-3s %15s;';
my $long_record =  '  %6s %-12s : %-3s %-15s(%10s %6s %10s);';
my $line;

while ($line = <DATA>) {
	if($line =~ /\s*port\(\s*(.+)\s*$/) {
		my @temp = $1;
		my %print;
		while ($line = <DATA>) {
			last if $line =~ /^end \w+;\s*$/;
			push @temp, $line;
		}
		
		foreach my $i (@temp) {
			my ($key, $value) = trim(split /\s*:\s*/, $i);
			$value =~ s/;//;
			$print{$_} = $value for trim(split(/\s*,\s*/, $key));
		}

		my @keys = sort keys %print;
		for (my $i = 0; $i <= $#keys; $i++) {
			if ($print{$keys[$i]} =~ m/([^\(]+)\s*\(([^)]+)\s*\)/) {
				printf $long_record, ($i == 0 ? 'port (' : ""), $keys[$i], 
						split(/\s+/, $1), split(/\s+/, $2);
			} else {
				printf $short_record, ($i == 0 ? 'port (' : ""), $keys[$i],
						split(/\s+/, $print{$keys[$i]});
			}
			
			if ($i == $#keys) {
				print ");\n";
			} else {
				print "\n";
			}
		}
		print $line;	# print 'end' message
	} else {
		print $line;
	}
}

sub trim {
    my @out = @_;
    for (@out) {
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @out : $out[0];
}

__DATA__
entity JK_FF is
  port( clock : in std_logic;
        J, K : in std_logic;
        reset : in std_logic;
        Q, Qbar : out std_logic;
		clk         : in std_logic;
		areset        : in std_logic;
		busy : out std_logic;
		writeEnable : in std_logic;
		readEnable : in std_logic;
		write    : in std_logic_vector(wordSize-1 downto 0);
		read    : out std_logic_vector(wordSize-1 downto 0);
		addr : in std_logic_vector(maxAddrBit downto minAddrBit));
end JK_FF;
The patterns for printf will probably need to be adjusted to match the rest of your data, but hopefully this gets you started.
 
That is excellent! Thanks so much for your time and effort, really do appreciate it!
 
Ok, one more question (probably trivial). How can I collect or store everything in a buffer (@buffer) without loosing the formatting, instead of printing it? I can always do later printf @buffer, if needed.

I quickly tried, for example: push @buffer, ($i == 0 ? 'port (' : ""), $keys[$i], split(/\s+/, $1), split(/\s+/, $2);
...but failed miserably...
 
Are you trying to store every record (ex. parse the entire log/file then print all the records at once) or just the attributes within a record (ex. parse then print one record at a time) in the array?

I guess the question should be: what do you want to do with the records once they are parsed?
 
Actually what I want is 'parse the entire log/file then print all the records at once'.

Briefly, I keep two buffers, one with the original code and another one with the nicified code as formatting progresses. When formatting's done, I dump my mod. buffer to a file.
 
Here are the relevant sections of the code. All the modified lines should be highlighted.
Code:
[b][blue]my @tidy_buffer;[/blue][/b]

while ($line = <DATA>) {
    if($line =~ /\s*port\(\s*(.+)\s*$/) {
        my @temp = $1;
        my (%print, $str);
        while ($line = <DATA>) {
            last if $line =~ /^end \w+;\s*$/;
            push @temp, $line;
        }
        
        foreach my $i (@temp) {
            my ($key, $value) = trim(split /\s*:\s*/, $i);
            $value =~ s/;//;
            $print{$_} = $value for trim(split(/\s*,\s*/, $key));
        }

        my @keys = sort keys %print;
        for (my $i = 0; $i <= $#keys; $i++) {
            if ($print{$keys[$i]} =~ m/([^\(]+)\s*\(([^)]+)\s*\)/) {
                [b][blue]$str = sprintf $long_record, ($i == 0 ? 'port (' : ""), $keys[$i],
                        split(/\s+/, $1), split(/\s+/, $2);[/blue][/b]
            } else {
                [b][blue]$str = sprintf $short_record, ($i == 0 ? 'port (' : ""), $keys[$i],
                        split(/\s+/, $print{$keys[$i]});[/blue][/b]
            }
            [b][blue]$str .= $i == $#keys ? ");\n" : "\n";
			push @tidy_buffer, $str;[/blue][/b]
        }
        [b][blue]push @tidy_buffer, $line;[/blue][/b]
    } else {
        [b][blue]push @tidy_buffer, $line;[/blue][/b]
    }
}
[b][blue]print for @tidy_buffer;[/blue][/b]
 
That is exactly what I meant!
Two more questions.
I need to remove the last ; on the row, for example:

addr : in std_logic_vector(maxAddrBit downto minAddrBit));

and not

addr : in std_logic_vector(maxAddrBit downto minAddrBit););

And the second one, say I have a buffer (@buffer) and need to replace a specific fragment of this buffer with another fragment (@tidy_buffer).

More specifically,
from:
$line =~ /\s*port\(\s*(.+)\s*$/)
to:
$line =~ /^end \w+;\s*$/;

is the fragment of @buffer that needs to be replaced with @tidy_buffer.



 
For the first question, take the semicolons out of the patterns you're using for sprintf and add them to the appropriate place in the bit that's adding the new lines. Something like:
Code:
$str .= $i == $#keys ? ");\n" : "[b][blue];[/blue][/b]\n";

For your second question, it might be the drinking I was doing earlier but I don't understand what you're trying to do. Replace a whole entity record or just a particular line? Maybe something entirely different?
 
Actually replace a whole Entity record in (@buffer), with @tidy_buffer, and leave all other lines (@buffer) intact.
 
How large are the files you're converting? Also, how many replacements are you looking at making?

The easiest way would probably be to use a hash of arrays (with another array [@order] to keep track of the order of the entities - if that's important.) Are all the entities uniquely named?
 
Ok, I see what you mean, but I think there is no need to do any of these, its getting way more complicated from what I actually need. Well I simply need a find and replace, not a line but a piece of code in my original buffer or @buffer (in my case, that will be this code fragment: entity JK_FF is->end JK_FF, replaced with the beautified one in @tidy_buffer).
Is this more clear now?
 
Take a look at the splice function (perldoc -f splice) it should do what you want.
 
I know am doing something terribly wrong here, but can you give me a hand?

Code:
$vhdl_filename = $ARGV[0];
open( FILE_IN, $vhdl_filename );

my @buffer = <FILE_IN>;

my $short_record = '  %6s %-12s : %-3s %15s';
my $long_record =  '  %6s %-12s : %-3s %-15s(%10s %6s %10s)';
my $line;
my @tidy_buffer;

while ($line = $buffer) {
  if($line =~ /\s*port\(\s*(.+)\s*$/) {
    my @temp = $1;
    my %print;
    while ($line = $buffer) {
...
...
...
}

print for @tidy_buffer;
close (FILE_IN);
 
Looking at your first example, there's no way to guarantee the record in @buffer is the same length as the one in @tidy_buffer. So you can't just replace one record for another.

If you're replacing the records in @buffer with the formatted records, why keep the original entries? Rather than reading all the lines into @buffer from the text file, you can do something like:

Code:
open FILE_IN ...
my (@buffer, $line);
while ($line = <FILE_IN>) {
  # Format the record
  .
  .
  # Store the record in @buffer
}
close FILE_IN;
 
It drives me mad, and I really can't find what goes wrong here!

[CODE}
## Number of indent spaces ##
$indent = " ";

## Prepare IN/OUT Files ##
$vhdl_filename = $ARGV[0];
$report_filename = $ARGV[1];
open( FILE_IN, $vhdl_filename );
open( FILE_OUT, ">$report_filename" );

my $short_record = ' %6s %-12s : %-3s %15s';
my $long_record = ' %6s %-12s : %-3s %-15s(%10s %6s %10s)';
my $line;

my (@buffer, $line);

while ( $line = <FILE_IN> ) {
if($line =~ /\s*port\(\s*(.+)\s*$/) {
.
. # Its all the same as before
.
push @buffer, $line; # print 'end' message
}
else {
push @buffer, $line;
}
}

# I've added this:

## Dump everything to buffer ##
undef $/; ### To read file all in one big slurp
$buffer = <FILE_IN>;
## Indent inner body of ARCHITECTURE->BEGIN ##
$nesting_level = 0; # init. nesting level
$cnt = 0; # init. counter
@buffer = split("\n", $buffer);
$buffer = '';

while ( $line = <FILE_IN> ) {
foreach my $line (@buffer) {
if ($line =~ m/^architecture/) {
if ($cnt == 0) {
$nesting_level++;
$cnt++;
}
}
if ($line =~ m/^begin/g) {
$nesting_level--;
}
if ( $line =~ m/^architecture/) { # Don't indent ARCHITECTURE!
$str .= $line . "\n";
push @buffer, $str;
}
else {
$str .= $indent x $nesting_level;
$str .= $line . "\n";
push @buffer, $str;
}
}
}

print FILE_OUT @buffer;

## Write Formatted Buffer and Close Files ##
close (FILE_IN);
close (FILE_OUT);
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top