#!/local/bin/perl

$instrepository = "./g++inst";
$builds_succeeded = 1;

sub every_other {
    local(@rval);
    while (@_) {
	push(@rval, shift(@_));
	shift(@_);
    }
    return @rval;
}

%MANGLINGS = ("int", "i",
	      "char", "c",
	      "short", "s",
	      "long", "l",
	      "float", "f",
	      "double", "d");

sub mangle {
    local($_) = @_;
    #print "asked to mangle $_\n";
    s/\s*([<,>])\s*/\1/g;
    if (/<.*>/) {
	local (@chars) = split(//);
	local($count, $stage)=(0,0);
	local($cname, $arg,@args);
	for ($i=0; $i<@chars; $i++) {
	    if ($chars[$i] eq "<") {
		$arg .= $chars[$i] if ($count>0);
		$count++;
	    } elsif ($chars[$i] eq ">") {
		$count--;
		if ($count==0) {
		    push(@args, $arg);
		} else {
		    $arg .= $chars[$i];
		}
	    } elsif ($chars[$i] eq "," && $count==1) {
		push(@args, $arg);
		$arg="";
	    } elsif ($count==0) {
		$cname .= $chars[$i];
	    } else {
		$arg .= $chars[$i];
	    }
	}
	die "$0: gnarled template name, \$count==$count " unless $count==0;
	local($allargs)="_";
	foreach $arg (@args) {
	    $allargs .= &mangle($arg);
	}
	local($rval) = $cname . "__pt__" . length($allargs) . $allargs;
	return length($rval).$rval;
    } elsif (/^\s*unsigned\s+/) {
	return "U".&mangle($');
    } elsif (defined($MANGLINGS{$_})) {
	return $MANGLINGS{$_};
    } else {
	return length($_).$_;
    }
}

sub ctime_of_file {
    local ($fname) = @_;
    local (@crap) = stat($fname);
    return $crap[10];
}

sub check_older {
    local ($target, @sources) = @_;

    return 0 if ( ! -f $target );

    local($tct) = &ctime_of_file($target);
    local ($_);
    foreach (@sources) {
	if ($tct < &ctime_of_file($_)) {
	    # print "$_:$tct is older than $target:", &ctime_of_file($_), "\n";
	    return 0;
	}
    }
    return 1;
}

sub build_from {
    local($fname, @requirements) = @_;

    local($oname, $oname2);
    ($oname = $fname) =~ s/\.c$/.o/;

    if (&check_older($oname, @_)) {
	print "$oname is up to date\n";
	return;
    }

    ($oname2 = $oname) =~ s-^.*/--g;

    # some compilers put the .o file in the current directory regardless
    die "$0: Error: $oname2 exists in current directory.  Move it out of the way or delete it please. " if ( -e $oname2 );

    local($|);
    $|=1;
    print "building $oname from $fname\n";

    local ($childpid);
    $childpid = fork;
    if ($childpid) {
	waitpid($childpid, 0);
    } else {
	exec $ENV{CCC}, "-c", @CPPARGS, $fname;
	die "$0: Error: unable to exec $ENV{CCC} "
    }
    #system("gnumake $oname");

    if ($? == 0) {
	# everything went OK

	if ( -e $oname2 ) {
	    rename ($oname2, $oname)
		|| die "$0: error: unable to rename $oname2 to $oname ";
	}
    } else {
	warn "build of $oname failed.  Continuing despite error\n";
	$builds_succeeded=0;
    }
}

sub instantiate {
    local($cn) = @_;
    local (@_);

    @_ = &every_other(split(/(\s*[<,>])+\s*/, $cn));

    local($_, %classes, @classes);
    foreach $_ (@_) {
	unless (defined $classes{$_}) {
	    push(@classes, $_);
	    $classes{$_} = 1;
	}
    }

    unless ( -d $instrepository ) {
	mkdir($instrepository, 0777) || die "$0: Error: Unable to create instantiation repository $instrepository ";
    }

    local($mangling) = &mangle($cn);
    $mangling =~ s/^\d+//;
    local($fname) = $instrepository."/".$mangling.".c";

    local($construct);

    $construct = "";

    $construct .= "\n// new instantiation\n";

    $construct .= "// mangled to ". $mangling. ", ok?\n";


    local ($first);
    $first = 1;
    #$construct .= "// first= $first\n";

    foreach $_ (@classes) {
	die "$0: Error: Unknown class $_ " unless defined $REQUIRES{$_};
	local($include);
	local (@requirements);
	@requirements = split(",", $REQUIRES{$_});
	# $construct .= "// for $_ first= $first\n";
	if ($first) {
	    @requirements = (@requirements, split(",", $IREQUIRES{$_}));
	}
	foreach $include (@requirements) {
	    $construct .= "#include $include\n";
	}
	$first=0;
    }
    $construct .= "template class $cn;\n";

    # check to see if we would actually change the file
    if ( -e $fname ) {
	open(FILE, "<$fname") || die "$0: error during dependency check.  Unable to open $fname for read ";
	local ($/) = -1;
	local ($_) = <FILE>;
#	print length($_) , " =? ", length($construct), "\n";
#	print $construct;
	if ($_ eq $construct) {
	    $construct = "";	# don't rewrite the file
	}
    }

    if ($construct ne "") {	# make sure we're making changes to the file
	open(FILE, ">$fname");
	print FILE $construct;
	close(FILE);
    }

    &build_from($fname, @requirements);
}

#
# main control flow
#

{
# teach this perl script that builtins don't need include files
    local($a,$b, $c);
    foreach $a ( "unsigned", "signed", "" ) {
	foreach $b ( "char", "short", "int", "long", "long long" ) {
	    $c = $a." ".$b; $c =~ s/^\s+//;
	    $REQUIRES{$c} = "";
	}
    }
    foreach $a ("float", "double", "long double" ) { $REQUIRES{$a} = ""; }
}

# parse arguments 

@CPPARGS=();
{
    local(@files, $_);

    foreach $_ (@ARGV) {
	if (/^-/) {
	    push(@CPPARGS, $_);
	} else {
	    push(@files, $_);
	}
    }
    @ARGV=@files;
}

# check environment

$ENV{CCC} = "c++" unless defined $ENV{CCC};

while ( <> ) {
    chop;

    if ( /\s+requires\s*/ ) {
	local ($class, $includes) = ($`, $');
	local ($headers, $implementation) = split( /\s+and\s+/, $includes );
	$REQUIRES{$class} = $headers;
	$IREQUIRES{$class} = $implementation;
    } elsif ( /^\s*instantiate\s+/ ) {
	&instantiate($')
    }

}

if ($builds_succeeded) {
    exit 0;
} else {
    die "$0: One of the subsidiary compiles failed.  Exiting with error\n";
}
