head	1.8;
access;
symbols
	r0_10:1.8
	Eglin_alpha_1:1.7;
locks; strict;
comment	@# @;


1.8
date	93.08.18.16.10.28;	author thoth;	state Exp;
branches;
next	1.7;

1.7
date	93.05.27.11.46.15;	author thoth;	state Exp;
branches;
next	1.6;

1.6
date	93.05.18.21.44.35;	author thoth;	state Exp;
branches;
next	1.5;

1.5
date	93.04.08.13.26.03;	author thoth;	state Exp;
branches;
next	1.4;

1.4
date	93.03.18.13.18.34;	author thoth;	state Exp;
branches;
next	1.3;

1.3
date	93.03.10.13.47.15;	author thoth;	state Exp;
branches;
next	1.2;

1.2
date	93.03.10.13.41.38;	author thoth;	state Exp;
branches;
next	1.1;

1.1
date	93.02.20.12.20.11;	author thoth;	state Exp;
branches;
next	;


desc
@perl script to generate C++ declarations for operations on images.
@


1.8
log
@Problems with the generation of the formal parameters in the
procedure body necessitate removal of special cases.
@
text
@#!/local/bin/perl

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

# $Id: generate-ops-h.perl,v 1.7 93/05/27 11:46:15 thoth Exp Locker: thoth $

#
# $Log:	generate-ops-h.perl,v $
# 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_DiscreteImage<".$1.">";
	} else {
		return $_;
	}
}

sub paramcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "const IA_DiscreteImage<".$1."> &";
	} elsif (1 ||
		 $_ eq "u_char" ||
		 $_ eq "int" ||
		 $_ eq "float" ||
		 $_ eq "double") {
		return $_;
	} else {
		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 "conversion") {
	    $oper = 1;
	    $bin = 0;
	    $comm = 0;
	} elsif ($_ eq "pointwise") {
	    $oper = 2;
	} elsif ($_ eq "strictrel") {
	    $oper = 3;

	} 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<4) || die "No value chosen for core operation (conversion, pointwise, or strictrel), stopped";
    ($comm<2) || die "No value chosen for commutativity, stopped";

    if ($_[0] =~ /^subop=/) {
	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), "(", &paramcodeof($lhs), ");\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
@


1.7
log
@Copyright Notices
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.6 93/05/18 21:44:35 thoth Exp Locker: thoth $
d12 3
d42 2
a43 1
	} elsif ($_ eq "u_char" ||
@


1.6
log
@Fixed totally erroneous handling of reductions.
@
text
@d3 4
a6 1
# $Id: generate-ops-h.perl,v 1.5 93/04/08 13:26:03 thoth Exp Locker: thoth $
d8 2
d12 3
@


1.5
log
@floats and u_chars are now passed by value.
@
text
@d3 1
a3 1
# $Id: generate-ops-h.perl,v 1.4 93/03/18 13:18:34 thoth Exp Locker: thoth $
d7 3
d131 1
a131 2
	$subop = shift(@@_);
	($rtype) = @@_;
d133 1
a133 1
		&paramcodeof("I($rtype)"),");\n";
@


1.4
log
@We now handle converions from one Image type to another.
operator <= is not mistaken for an opassign anymore.
@
text
@d3 1
a3 1
# $Id: generate-ops-h.perl,v 1.3 93/03/10 13:47:15 thoth Exp Locker: thoth $
d7 4
d28 4
a31 3
	} elsif ($_ eq "int" ||
		 $_ eq "double" ||
		 $_ eq "u_char") {
@


1.3
log
@*** empty log message ***
@
text
@d3 1
a3 1
# $Id: generate-ops-c.perl,v 1.2 93/03/10 13:38:55 thoth Exp $
d6 4
a9 1
# $Log:	generate-ops-c.perl,v $
d25 2
a26 1
		 $_ eq "double") {
d55 1
a55 1
    ($bin,$pwise,$comm,$optype) = (0,0,0,0);
d63 7
a69 2
	    $pwise = 0;
	    $binary = 0;
d71 1
a71 1
	    $pwise = 1;
d73 1
a73 1
	    $pwise = 2;
d79 1
a85 7
#	} elsif ($_ eq "function") {
#	    $optype = 0;
#	} elsif ($_ eq "operator") {
#	    $optype = 1;
#	} elsif ($_ eq "opeq") {
#	    $optype = 2;
#	    $binary = 0;
d96 11
a106 1
    $opeq = ($op =~ /=$/);
d108 9
d120 1
d122 1
a122 7
#    if ($optype==1 || $optype==2) {
#	$opname = "operator".$op;
#    } else {
#	$opname = $op;
#    }

    if (!$pwise) {
d127 3
d131 1
d155 1
@


1.2
log
@Infix detection is now automatic.
@
text
@d3 1
d5 2
@


1.1
log
@Initial revision
@
text
@d48 1
a48 1
    ($bin,$pwise,$comm,$isop) = (0,0,0,0);
d55 9
a63 1
    	if ($_ eq "binary") {
d67 1
a67 5
	} elsif ($_ eq "pointwise") {
	    $pwise = 1;
	} elsif ($_ eq "reduction") {
	    $pwise = 0;
	    $binary = 0;
d72 8
a79 7
	} elsif ($_ eq "operator") {
	    $isop = 1;
	} elsif ($_ eq "opeq") {
	    $isop = 2;
	    $binary = 0;
	} elsif ($_ eq "function") {
	    $isop = 0;
d88 3
a90 1
    $op = shift(@@_);
d92 2
a93 4
    if ($isop) {
	$opname = "operator".$op;
    } else {
	$opname = $op;
d96 6
d118 1
a118 1
		if ($isop) {
d133 1
a133 1
	if ($isop == 2) {
d138 7
a144 1
	print $opname,"(", &paramcodeof($arg),");\n";
@
