#!/usr/bin/perl -s
my $toplevel = pop;
# usage:
# module_hierarchy.pl [-r] verilog.v toplevelfunction
# for example:
# module_hierarchy.pl tom.v tom_stepx
# -r: don't follow recursions (experimental)
# -e: shows external names from the pvs2hdl comment output

# module regular expression
my $modulere;

while ( <> ) {
	if( m/^\s*module\s+(\w+)\(/i ) {
		# detected a module definition
		#warn '# detected a module definition';
		$current_module = $1;
		if( defined $modulere ) {
			substr($modulere,-1) = "|" . quotemeta($1) . ")";
		} else {
			$modulere = "(?:" . quotemeta($1) . ")";
		}
	} elsif( m/^\s*($modulere)\s+(\w+)\s+\(/ ) {
		warn "!ignoring module instantiation before module definition"
			unless defined $current_module;
		$modules{$current_module}{$2} = $1;
	} elsif( m#^\s*(?:wire|input|output)(?:\s+(\[\d+:\d+\]))?\s+(\w+)\s*;\s*//\s*external name: (.*)# ) {
		my ($internal,$external) = ("$2 $1",$3);
		$external =~ s/``/`/; # mah: I think this is an error in comment output of pvs2hdl
		$external = 'out' if $external eq 'out`';
		#warn "$current_module $internal $external";
		push @{$externalname{$current_module}}, "$internal: $external";
	} elsif( m/^\s*endmodule\s*$/i ) {
		# (not exactly necessary)
		#warn '# (not exactly necessary)';
		$current_module = undef;
	} else {
		# ignore the line
	}
}

sub printlevel {
	my ($path,$type) = @_;
	print "$path: $type\n";
	# step through all the son modules
	
	# if r option is set, do not follow certain module names:
	#return if  defined $r and $type =~ m/^\w+x(_\d+)+$/;

	my ($rootname) = $type =~ m/(\w+)x/;

	if( defined $e )  {
		# also expand 'external names' of this modules
		for $n ( @{$externalname{$type}} ) {
			print "$path.$n\n";
		}
	}

	for $m (sort keys %{$modules{$type}} ) {
		next if( defined $r and $modules{$type}{$m} =~ m/$rootname/ );
		printlevel("$path.$m",$modules{$type}{$m});
	}
}

# try to suffix and 'x' if toplevel does not exist
if( !exists $modules{$toplevel} ) {
	$toplevel .= 'x';
}
die "toplevel undefined...\n" unless exists $modules{$toplevel};

print '.'; # this is a hack
printlevel('',$toplevel);
