head	1.7;
access;
symbols
	bobbase:1.7
	bob:1.7.1
	r2_1:1.7
	r2_0:1.7
	r1_1_beta:1.7
	r1_1_alpha:1.6
	r1_0:1.6
	r0_11:1.5
	r0_10:1.4
	r0_9:1.1;
locks
	thoth:1.7.1.2; strict;
comment	@# @;


1.7
date	94.07.25.17.26.39;	author thoth;	state Exp;
branches
	1.7.1.1;
next	1.6;

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

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

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

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

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

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

1.7.1.1
date	94.12.28.18.29.39;	author thoth;	state Exp;
branches;
next	1.7.1.2;

1.7.1.2
date	95.01.13.19.37.42;	author thoth;	state Exp;
branches;
next	;


desc
@generator for image operation declarations.
@


1.7
log
@Name sanitization
@
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.6 1994/05/17 12:58:29 thoth Exp $

#
# $Log: generate-ops-h.perl,v $
# Revision 1.6  1994/05/17  12:58:29  thoth
# Improved operations generation scheme.  Lines from the op.desc file can
# be quoted into the .c file to allow inclusion of infrastructure.  Also
# the op.desc output can be redirected to several files.  The prefix
# directive allows common information (include files) to be included in
# every generated source file.
#
# Revision 1.5  1994/02/03  16:22:48  thoth
# Arguments to binary operations were specified "lhs rhs return" but are
# now specified "return lhs rhs" to be consistent with function declaration
# syntax.
#
# 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_Point<int>,".$1.">";
	} else {
		return $_;
	}
}

sub paramcodeof {
	local($_) = @@_;
	if (/^I\((.*)\)$/) {
		return "const IA_CoreImage<IA_Point<int>,".$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 (/^"HC?/) {  # "
	print $';
	next;
    } elsif (/^"C/) {  # "
	next;
    } elsif ( /^\s+$/) {
	next;
    }

    ($bin,$oper,$comm) = (2,4,2);
    print "//",$_;
    split;
#    print STDERR join(" ",@@_),"\n";
    while (@@_) {
    	$_ = shift(@@_);
	#print STDERR $_,"\n";
	if ($_ eq "filename") {
	    @@_ = (); last;
	} elsif ($_ eq "prefix") {
	    while (<>) {
		last if (/^end$/);
	    }
	    @@_ = (); last;	# next input line

	} elsif ($_ 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";
	($rtype, $lhs, $rhs) = @@_;

	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.1.1
log
@Image operations are now friendly with FBI.
constructors and conversions are impossible as ROF.
@
text
@d8 1
a8 1
# $Id: h-gen-ops.perl,v 1.7 1994/07/25 17:26:39 thoth Exp thoth $
d11 1
a11 4
# $Log: h-gen-ops.perl,v $
# Revision 1.7  1994/07/25  17:26:39  thoth
# Name sanitization
#
a80 11
$friend = "";
while (@@ARGV) {
    $_ = shift;
    if ($_ eq "-friends") {
	$friend = "friend ";
    } else {
	unshift(@@ARGV,$_);
	last;
    }
}

d89 2
d99 4
a102 6
    } elsif (/^"(H?)C?([fF]?)/) {  # "/) {
	if ($1 ne "") {
	    print $' if ($2 eq "f" && $friend eq "" ||
			 $2 eq "F" && $friend ne "" ||
			 $2 eq "");
	}
d194 3
a196 5
	if (1) {
	    print "//** constructors are obsolete?\n";
	} else {
	    ($lhs) = @@_;
	    print # &retcodeof($opname),
a198 1
	}
d200 4
a203 8
	if (1) {
	    print "//** conversions are obsolete?\n";
	} else {
	    ($lhs) = @@_;
	    print	"operator ",
	    &retcodeof($opname),
	    "( );\n";
	}
d213 4
a216 5
		if ($friend eq "") {
		    print "inline ",&retcodeof($rtype)," ",$opname,"(",
		    &paramcodeof($rhs)," lhs,",
		    &paramcodeof($lhs)," rhs) {\n";
		    if ($infix) {
d218 1
a218 1
		    } else {
a219 3
		    }
		} else {
		    print "//** doesn't need to be friendly\n";
d229 5
a233 2
	if ($opeq && $friend ne "")  {
	    print "// ** doesn't need to be friendly\n";
d235 4
a238 12
#	print "// $opname\n";
	    ($rtype, $arg) = @@_;
	    $retcname = &retcodeof($rtype);
	    if ($opeq) {
		print "inline ",$retcname," & ";
	    } else {
		print $friend,$retcname, " ";
	    }
	    print $opname,"(";
	    print $retcname, "& lhs, " if ($opeq);
	    print &paramcodeof($arg)," rhs)";
	    if ($opeq) {
d240 2
a241 2
		print " {\n    return lhs = lhs ",$`," rhs;\n}\n";
	    } else {
a242 1
	    }
@


1.7.1.2
log
@CoreImage has been re-merged with Image.  All special stuff should be
friends of FBI now.
@
text
@d8 1
a8 1
# $Id: h-gen-ops.perl,v 1.7.1.1 1994/12/28 18:29:39 thoth Exp thoth $
a11 4
# Revision 1.7.1.1  1994/12/28  18:29:39  thoth
# Image operations are now friendly with FBI.
# constructors and conversions are impossible as ROF.
#
d71 1
a71 1
		return "const IA_Image<IA_Point<int>,".$1."> &";
@


1.6
log
@Improved operations generation scheme.  Lines from the op.desc file can
be quoted into the .c file to allow inclusion of infrastructure.  Also
the op.desc output can be redirected to several files.  The prefix
directive allows common information (include files) to be included in
every generated source file.
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.5 1994/02/03 16:22:48 thoth Exp thoth $
d12 7
d59 1
a59 1
		return "IA_Image<IA_IntPoint,".$1.">";
d68 1
a68 1
		return "const IA_CoreImage<IA_IntPoint,".$1."> &";
@


1.5
log
@Arguments to binary operations were specified "lhs rhs return" but are
now specified "return lhs rhs" to be consistent with function declaration
syntax.
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.4 1994/01/31 15:57:35 thoth Exp thoth $
d12 5
d92 5
d108 9
a116 1
    	if ($_ eq "reduction") {
@


1.4
log
@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).
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.3 1994/01/07 15:10:00 thoth Exp thoth $
d12 5
d181 1
a181 1
	($lhs, $rhs, $rtype) = @@_;
@


1.3
log
@Image class is now CoreImage and named image types are
Image<P,T>.
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.2 1993/12/29 17:33:18 thoth Exp $
d12 4
d97 1
a97 1
	} elsif ($_ eq "conversion") {
d105 4
d149 1
a149 1
    ($oper<4) || die "No value chosen for core operation (conversion, pointwise, or strictrel), stopped";
d169 5
@


1.2
log
@New operator scheme that prevents the need for trivial Image conversions.
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.1 1993/09/15 13:04:21 thoth Exp thoth $
d12 3
d47 1
a47 1
		return "const IA_Image<IA_IntPoint,".$1."> &";
d157 4
a160 1
	print "/*PROMOTE*/",&retcodeof($opname), "(", &paramcodeof($lhs), ");\n";
d165 1
a165 1
	print $friend,"/*PROMOTE*/",&retcodeof($rtype)," ",$opname,"(",
d170 1
a170 1
		print $friend,"/*PROMOTE*/",&retcodeof($rtype)," ",$opname,"(",
d180 1
a180 1
		print $friend,"/*PROMOTE*/",&retcodeof($rtype)," ",$opname,"(",
d188 1
a188 1
	$retcname = "/*PROMOTE*/".&retcodeof($rtype);
@


1.1
log
@Initial revision
@
text
@d8 1
a8 1
# $Id: generate-ops-h.perl,v 1.7 93/05/27 11:46:15 thoth Exp Locker: thoth $
d11 4
a14 1
# $Log:	generate-ops-h.perl,v $
d141 3
a143 1
    if ($_[0] =~ /^subop=/) {
d154 1
a154 1
	print &retcodeof($opname), "(", &paramcodeof($lhs), ");\n";
d159 1
a159 1
	print $friend,&retcodeof($rtype)," ",$opname,"(",
d164 1
a164 1
		print $friend,&retcodeof($rtype)," ",$opname,"(",
d174 1
a174 1
		print $friend,&retcodeof($rtype)," ",$opname,"(",
d182 1
a182 1
	$retcname = &retcodeof($rtype);
@
