#!/usr/local/bin/perl5
# dataClimber: extract the dataTypes required to Ballista test a function
# Copyright (C) 1998-2001  Carnegie Mellon University
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

########################
#
# File:		dataClimber
#
# Usage:        dataClimber [-d <directory> ] [-i <input_file>] 
#                           [-o <output_file>] <mut>
#
#
# Description:  Extract the list of dataType required from the function prototype 
#               a given Mut
#
# Author:       Mark Hsu
#
#
########################
#
# Entry Conditions:
#              
########################

use strict;
use Getopt::Std;
use vars qw($opt_d $opt_i $opt_o);

#determine the name by which we were invoked
my $ARGV0 = $0;
$ARGV0 =~ s/.*\///;

# check usage
# NOTE - getops will set $opt_d.
#      - allows only for one arguments
unless  (getopts('d:i:o:') &&  @ARGV == 1)   {
	die "usage:  $ARGV0 [-d <directory> ] [-i <input_file>] [-o <output_file>] <mut>\n";
}

#if directory is not specified, assume templates is the base
my $DIRECTORY = $opt_d || 'templates';
my $IN_FILE = $opt_i || 'callTable';
my $OUT_FILE = $opt_o || 'dataTypes';

#set mut that we are working with
my $MUT = $ARGV[0];

##################################
# Grab the MuT declaration from callTable and extract 
# the dataType info.
#################################
my @dataType;	#array of dataTypes for the targetted MuT

# grab declaration from callTable file
open (CALLTABLE,"<$IN_FILE") || die "Can't open the file $IN_FILE: $!\n";
my @list  =  grep /$MUT/o, <CALLTABLE>;
close CALLTABLE;

#make sure it was in the callTable file
if (@list == 0) {
  die "Error:  MuT declaration not found in '$IN_FILE'\n";
}

#make sure there was only one instance found
my @declaration = grep /\b$MUT\b/, @list;
my $count = @declaration;
if ($count != 1) { 
    die "Error: Found $count MuT declaration(s).\n";
  }

#pull datatypes off the declaration line and put in dataType array
@dataType = ($declaration[0] =~ /$MUT\s+(.*)/);
@dataType = split /\s+/, $dataType[0]; #split them apart by whitespace
@dataType = grep {$_ !~ /\+/} @dataType; #remove + associated with phantom params

##################################
# Get data hierarchy for each dataType
##################################
my @dataHierAll; #array of all datatype's hierarchy and ctypes
my %cTypes;      #hash of ballista types to c types
my $top_parent = "paramAccess"; #top level datatype to not go beyond while searching

foreach my $child (@dataType) {
  my $parent;     #parent for the child dataType
  my $cTypeChild; #c datatype for child
  my %cycTest;    #hash used to determine cyclic relatonships

  #look at the hierarchy of current child and put parent and c datatype in hash
  while ($parent ne $top_parent) {
    my $file = "$DIRECTORY/$child.tpl";
    open (TPL, "<$file") || 
	die "Cannot open the required template file: $file\n $!\n";

    #reset these to undef for this round of searching
    $parent = undef;
    $cTypeChild = undef;
    while (<TPL>){
	#find child's c datatype
	if(/^\s*name\s+(\S+)\s+$child\s*;/){
	    $cTypeChild = $1;
	}
        #find child's parent
	if(/^\s*parent\s+(\w+)\s*;/){
	    $parent = $1;
	}
	#exit if we have both
	if ($parent && $cTypeChild){
	    last;
	}
    } #end while
    close TPL;

    #do some error checking
    unless ($parent){
        $! = 1; #set output to one
	die "Error: Can't find a parent in $child.tpl.\n";
    }
    unless ($cTypeChild){
        $! = 1;
	die "Error: Can't find c datatype in $child.tpl.\n";
    }    
    if ($cycTest{$parent}) {
	$! = 1;
	die "Error: Cyclic relationship in hierarchy for $child";
    }

    $cTypes{$child} = $cTypeChild; #add datatype to hash
    unshift @dataHierAll, $child;  #add child to list of completed types
    $cycTest{$child} = 1;          #add child to cyc hash test
    $child = $parent;              #move up one level
  } #end while ($parent ne $top_parent)
} #end foreach my $child (@dataType)

######################################
# Reduce the array of templates into minimal set
#  and print the final result to standard i/o.
######################################
my $typeBuff;   #string buffer to hold types to put in file
my %preventDup; #hash to prevent duplication of datatypes
my $tmpfile = "${OUT_FILE}aa"; # temporary file to hold output

foreach my $type (@dataHierAll) {
  if (!$preventDup{$type}) {
      $preventDup{$type} = 1;
      $typeBuff .= "$type $cTypes{$type}\n";
  }
}

while (-e $tmpfile) {
    $tmpfile++;
}

open(FH,">$tmpfile") || die "Can't open the file $OUT_FILE: $!\n";
print FH "#################################################\n";
print FH "# The datatype hierachy is generated for the MuT \n";
print FH "#   '$MUT' using the script '$ARGV0'.        \n";
print FH "#################################################\n";
print FH $typeBuff;
close FH;

# if the dataTypes file would not acutally change, we do not want to
#  modify it, so that dependancies in the Makefiles will work correctly
if (system("diff $OUT_FILE $tmpfile > /dev/null")) {
    rename $tmpfile, $OUT_FILE;
} else {
    unlink $tmpfile;
}

exit(0);
