#!/usr/bin/perl
#
#	cpm-v2:	a prototype "C with pattern matching" to C translator..
#
#	This second version of our tool reads every line of input,
#	identifies %when lines, copies all other lines to stdout
#	unchanged, and then parses each %when line into it's pieces.
#	Still quite easy in Perl!

#	(C) June 2018, Duncan C. White
#

use strict;
use warnings;
use 5.010;
use Data::Dumper;
use Function::Parameters;


my $infh;		# fd of current C+PM file we're translating
my $lineno = 0;		# current line no inside $infh
my $currline;		# current line (set by nextline(), used in fatal())


#
# my $line = nextline();
#	Read the next line from $infh, incrementing $lineno afterwards,
#	and return it.
#
fun nextline()
{
	my $line = <$infh>;
	$currline = $line;
	$lineno++;
	return $line;
}


#
# fatal( $whatsleft, $msg );
#	Given $whatsleft (a suffix of $currline) and a message $msg, print
#	a standard-formatted fatal error, pointing to the correct place in
#	the line (using length(currline) - length(whatsleft) as the basic
#	source of indentation information), and die.
#
fun fatal( $whatsleft, $msg )
{
	$currline =~ s/^\t/        /;		# expand tabs to spaces
	$whatsleft =~ s/^\t/        /;
	my $pos = length($currline) - length($whatsleft) - 1;
	my $indent = ' ' x $pos;
	my $err = "$currline$indent^ Error at line $lineno: $msg\n";
	die "\n$err\n";
}


#
# my( $command, $type, $var, $shape, $arglist ) = parse_when( $line );
#	After checking that $line starts with a %when, parse the rest of the
#	line.  If it parses return (command, type, var, shape, arglist)
#	otherwise die via fatal()
#
#	'%when' TYPE(ID) VAR(ID) 'is' SHAPE(ID) ( '(' ARGLIST ')' )
#	where ARGLIST is a comma separated list of typename paramname pairs,
#	where the typename and the paramname are IDs.
#
fun parse_when( $line )
{
	$line =~ s/^(%\S+)\s*//;
	my $command = $1;
	$command =~ s/shape$//;	# %when or %whenshape etc.. reduce to %when
	my $sofar = $command;

	fatal( $line, "ID (type name) expected after <<$sofar>>" )
		unless $line =~ s/^(\w+)\s+//;
	my $type = $1;
	$sofar .= " $type";

	fatal( $line, "ID (var name) expected after <<$sofar>>" )
		unless $line =~ s/^(\w+)\s+//;
	my $var = $1;
	$sofar .= " $var";

	fatal( $line, "'is' expected after <<$sofar>>" )
		unless $line =~ s/^is\s+//;

	return( $command, $type, $var, "", "" );
}


#
# handle_when( $line, $indent, $ofh );
#	Ok, $line starts with a %when (still in the line), and we've already
#	removed any leading indentation (in $indent).  Handle the %when line
#	and [eventually] it's following '{', printing valid C output to $ofh.
#
fun handle_when( $line, $indent, $ofh )
{
	my( $command, $type, $var, $shape, $arglist ) = parse_when( $line );
	print "debug: found $command type=$type, var=$var, shape=$shape, ".
		"arglist=$arglist\n";

	# produce the %when comment line
	print $ofh "$indent// $line:\n";
}


#
# handle_line( $line, $ofh );
#	handle $line [and if necessary, any subsequent lines of input],
#	print out whatever text is generated (or copied) to $ofh
#
fun handle_line( $line, $ofh )
{
	unless( $line =~ /^\s*%/ )
	{
		print $ofh "$line\n";
		return;
	}
	$line =~ s/^(\s*)//;
	my $indent = $1;
	print "debug: line is <<$line>> at line $lineno\n";

	fatal( $line, "%when expected" ) unless $line =~ /^%when/;
	handle_when( $line, $indent, $ofh );
}


die "Usage: cpm-v2 inputfile\n" unless @ARGV == 1;
my $inputfilename = shift;

my $cfilename = $inputfilename;
$cfilename =~ s/pm$//;

open( $infh, '<', $inputfilename ) || die "cpm: can't open $inputfilename\n";

unlink( $cfilename );
open( my $cfh, '>', $cfilename ) || die "cpm: can't create $cfilename\n";

while( defined( $_ = nextline() ) )
{
	chomp;
	handle_line( $_, $cfh );
}
close( $infh );
close( $cfh );
