#!/usr/bin/perl
#---------------------------------------------------------------------------#
# Copyright (C) 1995 University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#---------------------------------------------------------------------------#

# create a vi style tags file for Mercury programs
# takes its list of filenames from the command line
# it should warn about duplicate tags, but doesn't as yet

die "Usage: mtags file1.m ...\n" if $#ARGV < 0;

open(out, "| sort -u +0 -1 > tags") ||
	die "mtags: error opening pipe: $!\n";
while ($#ARGV >= 0)
{
	open(srcfile, $ARGV[0]) || die "mtags: can't open $ARGV[0]: $!\n";
	while ($_ = <srcfile>)
	{
		next if ($_ !~ /:- /);
		chop;

		($cmd, $decl, @rest) = split;
		$body = join(' ', @rest);
		if ($decl ne "pred" && $decl ne "type" && $decl ne "inst"
		&& ($decl ne "mode" || $body !~ /::/))
			{ next; }

		# printf "<%s> <%s>\n", $decl, $body;
		if ($decl ne "pred")
		{
			if ($body =~ /\.[ \t]*$/ &&
			$body !~ /--->/ && $body !~ /==/ && $body !~ /::/)
				{ next; }
		}

		$body =~ s/\.$//;
		$body =~ s/\(.*//;
		$body =~ s/ .*//;

		if ($body =~ m/[a-zA-Z_]/)
		{
			if ($bodies{$body} ne "seen")
			{
				printf out "%s\t%s\t/^%s\$/;-;/%s/\n", $body, $ARGV[0], $_, $body;
				$bodies{$body} = "seen";
			}
		}
	}

	close(srcfile) || die "mtags: error closing `$ARGV[0]': $!\n";
	shift(ARGV);
}
close(out) || die "mtags: error closing pipe: $!\n";
