#!/local/bin/perl

#
#	Copyright 1993, Center for Computer Vision and Visualization,
#	University of Florida.  All rights reserved.
#

#
# $Log: gen-conv-c.perl,v $
# Revision 1.6  1994/01/31  15:55:37  thoth
# prevented leakage of old values into new convolution specs.
#
# Revision 1.5  1994/01/07  15:24:40  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.4  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.3  1993/11/17  18:38:34  thoth
# template reductions are now supported.
# forward convolutions are now supported.
#
# Revision 1.2  1993/09/21  11:43:46  thoth
# the convolution description files can now have arbitrary
# white space in the operation specifications.
#
# Revision 1.1  93/09/15  13:03:22  thoth
# Initial revision
# 
# Revision 1.3  93/05/27  11:46:04  thoth
# Copyright Notices
# 
# Revision 1.2  93/04/29  11:21:43  thoth
# IBTYPE is now used in a #define symbol.
# 
# Revision 1.1  93/03/18  11:22:02  thoth
# Initial revision
# 

sub absorber_subst {
	local ($fname,
		$init, $forw_init, $accum, $accvar, $forw_accvar, $final,
		$rtype, $name, $itype, $tbtype, $titype, $zero) = @_;
	local ($ival, $tval, $rval) = ("#undef#","#undef#","#undef#");
	local($_);
	local($/) = -1;

	open(FILE, "<$fname") ||
		die "couldn't open $fname";

	$_ = <FILE>;

	if (m-^// _IVAL_=-) {
		print STDERR "IVAL: ", $';
	}

	s/\bFORW_INITIALIZE\b/$forw_init/g;
	s/\bINITIALIZE\b/$init/g;

	s/\bFORW_ACCUMULATEVAR\b/$forw_accvar/g;
	s/\bACCUMULATE\b/$accum/g;
	s/\bACCUMULATEVAR\b/$accvar/g;
	s/\bRESULT\b/$final/g;

	s/\bRTYPE\b/$rtype/g;
	s/CONV/$name/g;
	s/IBTYPE\b/$itype/g;
	s/\bTBTYPE\b/$tbtype/g;
	s/\bTITYPE\b/$titype/g;
	s/\bZERO\b/$zero/g;

	local(@_) = split("\n");
	foreach (@_) {
		if (m:^\s*//\s*_IVAL_=:)    { $ival = $'; next; }
		if (m:^\s*//\s*_TVAL_=:)    { $tval = $'; next; }
		if (m:^\s*//\s*_IRESULT_=:) { $rval = $'; next; }
		s/\bIVAL\b/$ival/g;
		s/\bTVAL\b/$tval/g;
		s/\bIRESULT\b/$rval/g;
	}

	print join("\n", @_);
	print "\n";

	$/ = '\n';

	close(FILE);
}

sub reduction_subst {
	local ($fname,
		$accum,
		$rtype, $name, $tbtype, $titype, $zero) = @_;
	local ($ival, $tval, $rval) = ("#undef#","#undef#","#undef#");
	local($_);
	local($/) = -1;

	open(FILE, "<$fname") ||
		die "couldn't open $fname";

	$_ = <FILE>;

	if (m-^// _IVAL_=-) {
		print STDERR "IVAL: ", $';
	}

	s/\bACCUMULATE\b/$accum/g;

	s/\bRTYPE\b/$rtype/g;
	s/REDUCT/$name/g;
	s/\bTBTYPE\b/$tbtype/g;
	s/\bTITYPE\b/$titype/g;
	s/\bZERO\b/$zero/g;

	local(@_) = split("\n");
	foreach (@_) {
		if (m:^\s*//\s*_TVAL_=:)    { $tval = $'; next; }
		if (m:^\s*//\s*_IRESULT_=:) { $rval = $'; next; }
		s/\bTVAL\b/$tval/g;
		s/\bIRESULT\b/$rval/g;
	}

	print join("\n", @_);
	print "\n";

	$/ = '\n';

	close(FILE);
}

while (<>) {
    next if /^\s*$/;

    if (/^#/) {
	print "//", $';
	next;
    }

    print "// $_";

    @_ = split;

    local($sort) = shift(@_);

    if ($sort eq "convolution") {

	local($rtype, $name, $itype, $ttype, @blah) = @_;
	$titype = "IA_Image<IA_IntPoint,$ttype> ";

	@_ = @blah;

	local($zero);

	while (@_) {
	    $_ = shift(@_);

	    if (/^zero=/) {
		$zero = $';
	    } else {
		warn "Unknown option $_. ";
	    }
	}

	local($init,$accum,$accvar,$final,$forw_init,$forw_accumvar);

	while ($_ = <>) {
	    chop;
	    last if $_ eq "end";

	    if (/^init:\s*/) {
		$init = $';
	    } elsif (/^accum:\s*/) {
		$accum = $';
	    } elsif (/^accvar:\s*/) {
		$accvar = $';
	    } elsif (/^final:\s*/) {
		$final = $';
	    } elsif (/^forw_init:\s*/) {
		$forw_init = $'
	    } elsif (/^forw_accumvar:\s*/) {
		$forw_accumvar = $'
	    } else {
		die "unknown convolution field: $_\n";
	    }
	}
	defined $init || die "no initiazlier for backward convolution $name\n";
	defined $accum || die "no accumulator for backward convolution $name\n";
	$accvar = $accum unless defined $accvar;
	defined $final || die "no final for backward convolution $name\n";
	defined $forw_init || die "no initializer for forward convolution $name\n";
	defined $forw_accumvar || die "no accumulator for forward convolution $name\n";

	if ($zero ne "") {
	    &absorber_subst("absorber", $init, $forw_init,
			    $accum, $accvar, $forw_accumvar, $final,
			    $rtype, $name, $itype, $ttype, $titype, $zero);
	} else {
	    print "// non-absorbers not handled yet\n";
	}

	print "\n";
    } elsif ($sort eq "reduction") {
	local($rtype, $name, $ttype, @blah) = @_;
	$titype = "IA_Image<IA_IntPoint,$ttype> ";

	@_ =  @blah;

	local($zero);

	while (@_) {
	    $_ = shift(@_);

	    if (/^zero=/) {
		$zero = $';
	    } else {
		warn "Unknown option $_. ";
	    }
	}

	$_ = <>; chop;
	/^accum:\s*/ || die "no accumulator for convolution $name\n";
	$accum = $';

	if ($zero ne "") {
	    &reduction_subst("template-reduction", $accum, $rtype,
			    $name, $ttype, $titype, $zero);
	} else {
	    print "// template reductions without an identity are not implemented\n";
	}
    }
}
