#!/usr/bin/perl
#
#	cint:	a prototype "C with interfaces" to C translator..
#
#		This tool contains an experimental "C with go-style interfaces"
#		to C translator based on some thoughts I had about how could
#		we implement Go-style interfaces to packages in C.  It's a side
#		effect of a LinkedIn discussion that I started in the Plain
#		Ordinary C group, to discuss my TEFEL idea - Nigel Evans
#		suggested some form of lightweight OO for C, on the lines of
#		JavaScript's prototype-based model, and I said "or what
#		about Go-style interfaces.."  and then started thinking:-)
#
#		This is the result.  It translates a single F.interface
#		"C+Interfaces" source file to the corresponding F.h
#		file implementing that interface - the F.c will be produced
#		by a later version of this tool
#
#	(C) August 2018, Duncan C. White
#

use strict;
use warnings;
use 5.010;
use Data::Dumper;
use Getopt::Long;
use Function::Parameters;
use FindBin qw($Bin);

use lib "$Bin";
use Support;
use Sig;


my $interface;		# name of current interface
my %isfunc;		# set of all marked functions in the interface
my @func;		# the marked functions in the order we saw them
my @structfield;	# the structure fields
my %seensig;		# the set of signatures we've already seen
my %funcsig;		# function -> signature mapping


#
# my $error = checkfunc( $funcname );
#	Check whether function $funcname is already defined - if so, return
#	a sensible error message, otherwise return undef.  Also marks the
#	function as defined..
#
fun checkfunc( $funcname )
{
	return "function $funcname already defined" if $isfunc{$funcname}++;
	return undef;
}


#
# my $text = handle_line( $line );
#	handle $line, modifying @structfield and %seensig, returning any
#	text (in plain C format) that should go straight into the .h file.
#
fun handle_line( $line )
{
	return $line unless $line =~ /^%/;		# copy non-% lines

	if( $line =~ s/^(\s*)%func\s*// )		# found %func?
	{
		#print "found %func\n";
	        my $origindent = $1;
		my( $ok, $info ) = parse_func_line( $line, \&checkfunc );
		fatal( $line, $info ) unless $ok;

		my $funcname = $info->{FUNCNAME};
		my $rettype  = $info->{RETURNTYPE};
		my $origline = $info->{ORIGLINE};
		my $params   = $info->{PARAMS};
		my $sig      = makesig( $rettype, @$params );
		my $typename = "${interface}_${sig}_f";

		print "debug: found func $origline with sig $sig\n";

		my $htext = "";
		unless( $seensig{$sig}++ )
		{
			my $args = join( ', ', map {
				s/\w+$//;	# remove the parameter name
				$_;
			} @$params );
			$args = "void" unless $args;
			$htext = "typedef $rettype (*$typename)( $args );\n";
		}
		push @structfield, "$typename $funcname;";
		push @func, $funcname;
		$funcsig{$funcname} = $sig;

		return $htext;
	}
	fatal( $line, "Unhandled % line" );
}


#
# my $text = makestruct( $interface, @structfield );
#	Generate the structure type for the interface..
#
fun makestruct( $interface, @structfield )
{
	my $struct = "typedef struct\n{\n";
	$struct .= join( '', map { s/^/\t/; "$_\n" } @structfield );
	$struct .= qq(} $interface;\n);

	my $str = qq(
// This represents the "interface $interface" at run-time.
// It's a container of SLOTS for the $interface functions..
$struct
	);
	return $str;
}


#
# my $str = makebind( $extern, $interface );
#	Generate the bind function definition or declaration for the
#	current interface
#
fun makebind( $extern, $interface )
{
	my $str = qq[
/*
 * $interface *in = ${interface}_bind( char *module, char *errmsg );
 *	Attempt to "bind" lib<module>.so to the $interface interface:
 *	Load "lib<module>.so" into memory, and attempt to locate all the
 *	required function symbols inside the library.  For each function
 *	called <fname>, we look first for a symbol "fname", then if that fails,
 *	for a symbol ""module_fname".
 *
 *	If we fail to find even one of the required functions: strcpy
 *	an error message into errmsg and return NULL
 *
 *	If we succeed then we say we have "bound" the module to the interface:
 *	we return an newly malloc()d $interface object with the slot function
 *	pointers bound to the corresponding functions in lib<module>.so
 */
$extern$interface *${interface}_bind( char *module, char *errmsg )];
	return $str;
}


die "Usage: cint filename\n" unless @ARGV == 1;

my $inputfilename = shift;
$interface = $inputfilename;
$interface =~ s/\.interface$//;
my $cfilename = "$interface.c";
my $hfilename = "$interface.h";

openfile( $inputfilename ) || die "cint: can't open $inputfilename\n";

unlink( $cfilename );
unlink( $hfilename );

my $htext = "";		# generated .h file contents
while( defined( $_ = nextline() ) )
{
	$htext .= handle_line( $_ );
}

# make the struct definition for the interface..
$htext .= makestruct( $interface, @structfield );

# make the bind heading for the interface..
$htext .= makebind( "extern ", $interface ).";\n";

# build the .h file
open( my $hfh, '>', $hfilename ) || die "cint: can't create $hfilename\n";
print $hfh $htext;
close( $hfh );
