#!/local/bin/perl

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

# $Id: generate-ops-h.perl,v 1.4 1994/01/31 15:57:35 thoth Exp $

#
# $Log: generate-ops-h.perl,v $
# Revision 1.4  1994/01/31  15:57:35  thoth
# What was previously called conversion is really a constructor.  We have
# a new thing that is truly a conversion (for stuff like int->float in the
# int class).
#
# Revision 1.3  1994/01/07  15:10:00  thoth
# Image class is now CoreImage and named image types are
# Image<P,T>.
#
# Revision 1.2  1993/12/29  17:33:18  thoth
# New operator scheme that prevents the need for trivial Image conversions.
#
# Revision 1.1  1993/09/15  13:04:21  thoth
# Initial revision
#
# Revision 1.7  93/05/27  11:46:15  thoth
# Copyright Notices
# 
# Revision 1.6  93/05/18  21:44:35  thoth
# Fixed totally erroneous handling of reductions.
# 
# Revision 1.5  93/04/08  13:26:03  thoth
# floats and u_chars are now passed by value.
# 
# Revision 1.4  93/03/18  13:18:34  thoth
# We now handle converions from one Image type to another.
# operator <= is not mistaken for an opassign anymore.
# 
# Revision 1.3  93/03/10  13:47:15  thoth
# *** empty log message ***
# 

sub retcodeof {
	local($_) = @_;
	if (/^I\((.*)\)$/) {
		return "IA_Image<IA_IntPoint,".$1.">";
	} else {
		return $_;
	}
}

sub paramcodeof {
	local($_) = @_;
	if (/^I\((.*)\)$/) {
		return "const IA_CoreImage<IA_IntPoint,".$1."> &";
	} elsif (1 ||
		 $_ eq "u_char" ||
		 $_ eq "int" ||
		 $_ eq "float" ||
		 $_ eq "double") {
		return $_;
	} else {
		# gotta find a way to do this
		return "const ".$_." &";
	}
}

print <<EOT
// Emacs -*- C++ -*-

// Machine generated include file, do not modify.

EOT
;

$friend = "friend ";

while (<>) {
    if (/^#/) {
	if ($' eq "\n") {
	    print $';
	} else {
	    print "// ",$';
	}
	next;
    } elsif ( /^\s+$/) {
	next;
    }

    ($bin,$oper,$comm) = (2,4,2);
    print "//",$_;
    split;
#    print STDERR join(" ",@_),"\n";
    while (@_) {
    	$_ = shift(@_);
	#print STDERR $_,"\n";
    	if ($_ eq "reduction") {
	    $oper = 0;
	    $bin = 0;
	    $comm = 0;
	} elsif ($_ eq "constructor") {
	    $oper = 1;
	    $bin = 0;
	    $comm = 0;
	} elsif ($_ eq "pointwise") {
	    $oper = 2;
	} elsif ($_ eq "strictrel") {
	    $oper = 3;
	} elsif ($_ eq "conversion") {
	    $oper = 4;
	    $bin = 0;
	    $comm = 0;

	} elsif ($_ eq "binary") {
	    $bin = 1;
    	} elsif ($_ eq "unary") {
	    $bin = 0;
	    $comm = 0;

	} elsif ($_ eq "commutative") {
	    $comm = 1;
	} elsif ($_ eq "non-commutative") {
	    $comm = 0;

	} else {
	    unshift(@_,$_);
	    last;
	}
    }

    unless (@_) { next; }

    $opname = $op = shift(@_);
    $infix = ($op =~ s/^operator//);
    $opeq = 0;
    if ($op =~ /=$/) {
	local($_) = $`;
	if (!/^[<=>]$/) {
	    $opeq = 1;
	    #print "opeq $_\n";
        } else {
	    #print "not opeq $_\n";
	}
    }
#    $opeq = (($op =~ /=$/) && ($` !~ m/<=>/));

    if ($opeq) {
	$bin = 0;
	$comm = 0;
    }

    ($bin<2) || die "No value chosen for arity $bin, stopped";
    ($oper<5) || die "No value chosen for core operation (constructor, conversion, pointwise, or strictrel), stopped";
    ($comm<2) || die "No value chosen for commutativity, stopped";

    while (1) {
	last unless ( ($_[0] =~ /^subop=/)
		     || ($_[0] =~ /^zero=/) );
	shift(@_);
    }
#	print "$opname $bin $oper\n";

    if ($oper == 0) {
	($rtype, $argtype) = @_;
	print $friend,&retcodeof($rtype)," ", $op, "(",
		&paramcodeof("$argtype"),");\n";
    } elsif ($oper==1) {
	($lhs) = @_;
	print
		# &retcodeof($opname),
		"IA_Image",
		"(", &paramcodeof($lhs), ");\n";
    } elsif ($oper==4) {
	($lhs) = @_;
	print	"operator ",
		&retcodeof($opname),
		"( );\n";
    } elsif ($bin) {
	#print join(",",@_),"\n";
	($lhs, $rhs, $rtype) = @_;

	print $friend,&retcodeof($rtype)," ",$opname,"(",
		&paramcodeof($lhs),",",
		&paramcodeof($rhs),");\n";
	if ($lhs ne $rhs) {
	    if ($comm) {
		print $friend,&retcodeof($rtype)," ",$opname,"(",
		&paramcodeof($rhs)," lhs,",
		&paramcodeof($lhs)," rhs) {\n";
		if ($infix) {
			print "    return rhs${op}lhs;\n}\n";
		} else {
			print "    return $op(rhs,lhs);\n}\n";
		}
	    } elsif (1) {
	    } else {
		print $friend,&retcodeof($rtype)," ",$opname,"(",
		&paramcodeof($rhs),",",
		&paramcodeof($lhs),");\n";
	    }
	}
    } else { # unary
#	print "// $opname\n";
	($rtype, $arg) = @_;
	$retcname = &retcodeof($rtype);
	if ($opeq) {
	    print $retcname," & ";
	} else {
	    print $friend,$retcname, " ";
	}
	print $opname,"(", &paramcodeof($arg)," arg)";
	if ($opeq) {
		$op =~ /=$/;
		print " {\n    return (*this) = (*this) ",$`," (arg);\n}\n";
	} else {
		print ";\n";
	}
    }
    print "\n";
}

exit 0;

print<<EndOfDescription

Lines beginning with a # are ignored.


EndOfDescription
