#!/usr/bin/perl
# GPL(C) http://www.cs.albany.edu/~mosh Mohsin Ahmed
# SYNOPSIS: Senseless or Sensible names in verilog source.
# Does a uniform substution of \varabc varxyz by prefix_001 ...

use strict;

my $symfile = 'sym.tab';

my $usage = "usage: $0 -p:prefix -m:pattern -n:pattern args
   -p:prefix   Start variable names from prefix001
   -m:pattern  Rename all variables matching (regexp) pattern.
   -n:pattern  Donot rename these variables.
               Can have multiple patterns, subsequent patterns are or'ed.
   -c          Compact spaces.
   -v          Verbose.
   -d          Dump symbol table to $symfile.
   -bv         Substitute \\vars.
   -ov         Substitute other vars.
 eg.
   veriname.pl -p:mx -m:'mosh|NET_|Cell|cell_|\\\\' infile.v > outfile.v
    (that's two backslashes when typed on cmd line to rid of \\var ).
";

my( $pat_onlyvar, $pat_notvar);
my( $prefix, $start );
my( $op_compact, $op_otvar, $op_bsvar, $op_dumpsym, $op_verbose );

while( $_ = $ARGV[0],  m/^-/ ){
    shift; last if /^--$/;
    if( m/^-v/ ){ $op_verbose=1;
    }elsif( m/^-p:(.+)/ ){ $prefix=$1;
    }elsif( m/^-c/ ){ $op_compact=1;
    }elsif( m/^-d/ ){ $op_dumpsym=1;
    }elsif( m/^-bv/ ){ $op_bsvar=1;
    }elsif( m/^-ov/ ){ $op_otvar=1;
    }elsif( m/^-m:(.+)/ ){ 
        $pat_onlyvar .= '|' if defined $pat_onlyvar;
        $pat_onlyvar .= $1;
    }elsif( m/^-n:(.+)/ ){ 
        $pat_notvar .= '|' if defined $pat_notvar;
        $pat_notvar .= $1;
    }elsif( m/^-[?h]/i ){ die $usage;
    }else{ die "unknown option '$_'\n";
    }
}

die "Do what? See -h for help.\n" unless defined @ARGV;

$prefix ||= "ma_";
warn "prefix='$prefix', var=~ m/$pat_onlyvar/ && !/$pat_notvar/, gulping file.\n";

undef $/;
$_ = <>;        # Read all input into $_.

# ================================================
# Make sure we don't use names already in use, easily possible
# when rerunning the script on same input.

$start = '0000'; # Four digit name counter added after prefix.

if( $prefix =~ s/(\d+)$// ){
    $start = $1;
}

warn "Looking for $prefix variables already in use.\n";

my %uniq; # Also updated by getnewsym().
while( m/(${prefix}\d+)/g ){
    $uniq{$1} = 1;
}


# ================================================
my %bsvar;      # New names for \var_
if( $op_bsvar ){
    warn "Find \\variables.\n";

    my $bscount;
    BSVAR: while( m/(\\\S+\s)/g ){
        my $old = "\Q$1\E";
        next unless $pat_onlyvar and $old =~ m/$pat_onlyvar/o;
        next     if $pat_notvar  and $old =~ m/$pat_notvar/o;
        next BSVAR if defined $bsvar{$old};  # already seen this one?
        $bsvar{$old} = getnewsym() . " ";
        $bscount++;
    }

    warn "Replacing \\variables ($bscount).\n";
    my( $old, $substcount );
    foreach $old (keys %bsvar) {
        next unless $pat_onlyvar and $old =~ m/$pat_onlyvar/o;
        next     if $pat_notvar  and $old =~ m/$pat_notvar/o;
        my $new = $bsvar{$old};
        $substcount = s,$old,$new,gm;
        warn "s,$old,$new,gm = $substcount substituted ($bscount \\var left).\n"
            if $op_verbose;
        $bscount--;
    }
}
# ================================================
my %otvar;      # New names for other_variables.
if( $op_otvar ){
    warn "Now looking for other variables.\n";

    my $otcount = 0;
    OTVAR: while( m/\b([\w\d_]+)\b/g ){
        my $old = $1;
        next OTVAR if defined $otvar{$old};
        next unless $pat_onlyvar and $old =~ m/$pat_onlyvar/o;
        next     if $pat_notvar  and $old =~ m/$pat_notvar/o;
        next OTVAR if defined $otvar{$old}; # already seen this one?
        $otvar{$old} = getnewsym();
        $otcount++;
    }

    warn "Now replacing other variables ($otcount).\n";
    my( $old, $substcount );
    foreach $old (keys %otvar) {
        next unless $pat_onlyvar and $old =~ m/$pat_onlyvar/o;
        next     if $pat_notvar  and $old =~ m/$pat_notvar/o;
        my $new = $otvar{$old};
        $substcount = s/\b$old\b/$new/gm;
        warn "s,$old,$new,gm = $substcount substituted ($otcount otvar left).\n"
            if $op_verbose;
        $otcount--;
    }
}
# ================================================
# Clean up before printing.

if( $op_compact ){
    warn "Compacting.\n";
    # Problem: \x[1] , y => \x[1],y
    s/\s\w+\s+([;,])/$1/g;       # x , y => x, y  
    s/\n\n+/\n/gm;      # \n\n  => \n
    s/\s(\w)\s+\(/$1(/g;  # f ()  => f()
}

warn "Writing new file.\n";
print;

if( $op_dumpsym ){
    warn "Dumping symbols.\n";
    open( SYM, ">$symfile" )
        or die "Cannot write $symfile.\n";

    print "# \%uniq - symbols in use map.\n";
    foreach (keys %uniq ){ printf "%s=%s\n", $_, $uniq{$_}; }
    print "# \%bsvar - backslashed symbol map\n";
    foreach (keys %bsvar){ printf "%s=%s\n", $_, $bsvar{$_}; }
    print "# \%otvar - other symbol map.\n";
    foreach (keys %otvar){ printf "%s=%s\n", $_, $otvar{$_}; }

    close SYM;
    warn "Wrote $symfile.\n";
}

warn "Done.\n";
# ==========================
# Returns a new "prefix_N" not in %uniq table.
# Reads global $prefix, updates global %uniq, $start.
sub getnewsym {
    # Don't do a m/// here! 
    my $newsym = $prefix . $start++;
    while( exists $uniq{$newsym} ){
        $newsym = $prefix . $start++;
    }
    return $newsym;
}

# EOF