#!/usr/bin/perl -w

open(FILE, "treefuncs.def") || die("Can't open treefuncs.def");
open(OUTC, ">treefuncs.c") || die("Can't open treefuncs.c");
open(OUTH, ">treefuncs.h") || die("Can't open treefuncs.h");

print OUTC  "/* Generated by generate_treefuncs.pl from treefuncs.def!\n";
print OUTC " * Do not edit by hand! */\n\n";
print OUTH "/* Generated by generate_treefuncs.pl from treefuncs.def!\n";
print OUTH " * Do not edit by hand! */\n\n";

$typedefs = "typedef union _Node Node;\n";
$typeenums = "enum {\n";

$typename = "";
%typestruct = ();
%newfunc = ();
%newfunc_prot = ();
%freefunc = ();
%freefunc_prot = ();
%copyfunc = ();
%copyfunc_prot = ();

$var = "";
$type = "";
$copy = "";
$free = "";

$headercode = "";

$inheadercode = 0;

$vars = 0;

sub end_var {
	$typestruct{$typename} .= "\t$type $var;\n";

	if($vars == 0) {
		$newfunc_prot{$typename} .= "$type $var";
	} else {
		$newfunc_prot{$typename} .= ", $type $var";
	}
	$vars++;

	$newfunc{$typename} .= "\tself->$var = $var;\n";

	if($copy ne "") {
		$tmp = $copy;
		$tmp =~ s/__VAL__/self->$var/g;
		$tmp =~ s/__LVAL__/new->$var/g;
		$copyfunc{$typename} .= "\t$tmp\n";
	} else {
		$copyfunc{$typename} .= "\tnew->$var = self->$var;\n";
	}
	if($free ne "") {
		$tmp = $free;
		$tmp =~ s/__VAL__/self->$var/g;
		$freefunc{$typename} .= "\t$tmp\n";
	}
}

while(<FILE>) {
	if($inheadercode) {
		if(/^ENDHEADER$/) {
			$inheadercode = 0;
			next;
		}
		$headercode .= $_;
		next;
	}
		
	s/#.*$//;

	if(/^[ \t]*HEADER[ \t]*$/) {
		$inheadercode = 1;
		next;
	}

	if(/^[ \t]*CLASS[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$typename = $1;
		$lct = lc $typename;
		$uct = uc $typename;

		$vars = 0;

		$typeenums .= "\t$uct"."_NODE,\n";

		$typedefs .= "typedef struct _$typename $typename;\n";

		$typestruct{$typename} = "struct _$typename {\n\tint type;\n";
		$newfunc_prot{$typename} = "Node * new_$lct (";
		$copyfunc_prot{$typename} = "$typename * copy_$lct ($typename * self)";
		$freefunc_prot{$typename} = "void free_$lct ($typename * self)";

		$newfunc{$typename} = "{\n" .
					"\t$typename * self = g_new0($typename, 1);\n" .
					"\tself->type = $uct"."_NODE;\n";
		$copyfunc{$typename} = "{\n" .
					"\t$typename * new;\n" .
					"\tg_return_if_fail(self != NULL);\n" .
					"\tg_return_if_fail(self->type == $uct"."_NODE);\n" .
					"\tnew = g_new0($typename, 1);\n" .
					"\tnew->type = $uct"."_NODE;\n";
		$freefunc{$typename} = "{\n\tg_return_if_fail(self != NULL);\n" .
					"\tg_return_if_fail(self->type == $uct"."_NODE);\n";

		next;
	}

	#ignore everything until we get some typename
	if($typename eq "") {
		next;
	}
	
	#some predefined VARIABLE types
	if(/^[ \t]*INT[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "int";
		$copy = "__LVAL__ = __VAL__;";
		$free = "";
		end_var;
		next;
	} elsif(/^[ \t]*BOOL[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "gboolean";
		$copy = "__LVAL__ = __VAL__;";
		$free = "";
		end_var;
		next;
	} elsif(/^[ \t]*STRING[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "char *";
		$copy = "__LVAL__ = g_strdup(__VAL__);";
		$free = "g_free(__VAL__);";
		end_var;
		next;
	} elsif(/^[ \t]*STRINGLIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "GList *";
		$copy = "__LVAL__ = g_list_copy(__VAL__); COPY_LIST_VALS(__LVAL__, g_strdup);";
		$free = "g_list_foreach(__VAL__, (GFunc)g_free, NULL); g_list_free(__VAL__);";
		end_var;
		next;
	} elsif(/^[ \t]*NODELIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "GList *";
		$copy = "__LVAL__ = copy_node_list(__VAL__);";
		$free = "free_node_list(__VAL__);";
		end_var;
		next;
	#We assume one of the classes we are creating is named Type
	} elsif(/^[ \t]*TYPE[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "Type *";
		$copy = "__LVAL__ = copy_type(__VAL__);";
		$free = "free_type(__VAL__);";
		end_var;
		next;
	#generic variable type
	} elsif(/^[ \t]*VAR[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
		$var = $1;
		$type = "int";
		$copy = "__LVAL__ = __VAL__;";
		$free = "";
		next;
	} elsif(/^[ \t]*CTYPE[ \t]+(.+)[ \t]*$/) {
		$type = $1;
		next;
	} elsif(/^[ \t]*COPY[ \t]+(.+)$/) {
		$copy = $1;
		next;
	} elsif(/^[ \t]*FREE[ \t]+(.+)$/) {
		$free = $1;
		next;
	} elsif(/^[ \t]*ENDVAR[ \t]*$/) {
		end_var;
		next;
	} elsif(/^[ \t]*ENDCLASS[ \t]*$/) {
		$typestruct{$typename} .= "};";
		$newfunc_prot{$typename} .= ")";

		$newfunc{$typename} .= "\treturn (Node *)self;\n}";
		$copyfunc{$typename} .= "\treturn new;\n}";
		$freefunc{$typename} .= "\tg_free(self);\n}";
		$typename = "";
		next;
	} else {
		next;
	}
}

$typeenums .= "\tLAST_NODE_TYPE\n};";

print OUTH "\n#ifndef _TREEFUNCS_H_\n";
print OUTH "\n#define _TREEFUNCS_H_\n";

print OUTH "\n$headercode\n\n";
print OUTH "$typeenums\n\n";
print OUTH "$typedefs\n\n";

foreach $t (sort keys %typestruct) {
	print OUTH "$typestruct{$t}\n\n";
}

print OUTH "union _Node {\n\tint type;\n";

foreach $t (sort keys %typestruct) {
	$foo = lc $t;
	if($foo eq "type") {
		print OUTH "\t$t _type;\n";
	} else {
		print OUTH "\t$t $foo;\n";
	}
}
print OUTH "};\n\n";


print OUTH "/* New functions */\n";

foreach $t (sort keys %newfunc_prot) {
	print OUTH "$newfunc_prot{$t};\n";
}

print OUTH "\n/* General copy/free functions */\n";
print OUTH "Node * copy_node(Node *node);\n";
print OUTH "void free_node(Node *node);\n\n";
print OUTH "GList * copy_node_list(GList *nodes);\n";
print OUTH "void free_node_list(GList *nodes);\n";

print OUTH "\n/* Copy functions */\n";
foreach $t (sort keys %copyfunc_prot) {
	print OUTH "$copyfunc_prot{$t};\n";
}
print OUTH "\n/* Free functions */\n";
foreach $t (sort keys %freefunc_prot) {
	print OUTH "$freefunc_prot{$t};\n";
}

print OUTH "\n#endif /*_TREEFUNCS_H_*/\n";

close(OUTH);

print OUTC "#include <glib.h>\n#include \"treefuncs.h\"\n\n";
print OUTC "#define COPY_LIST_VALS(list,func) " .
	"{ GList *li; for(li=(list);li;li=li->next) { li->data=func(li->data); } }\n\n";

foreach $t (sort keys %newfunc_prot) {
	print OUTC "$newfunc_prot{$t}\n$newfunc{$t}\n\n";
}

foreach $t (sort keys %copyfunc_prot) {
	print OUTC "$copyfunc_prot{$t}\n$copyfunc{$t}\n\n";
}

foreach $t (sort keys %freefunc_prot) {
	print OUTC "$freefunc_prot{$t}\n$freefunc{$t}\n\n";
}

print OUTC "Node * copy_node(Node *node)\n" .
	   "{\n" .
	   "\tg_return_if_fail(node != NULL);\n" .
	   "\tg_return_if_fail(node->type >= 0 && node->type < LAST_NODE_TYPE);\n" .
	   "\tswitch(node->type) {\n";
foreach $t (sort keys %typestruct) {
	print OUTC "\tcase " . uc($t) . "_NODE: return (Node *)copy_" . lc($t) . " (($t *)node);\n";
}
print OUTC "\tdefault: return NULL;\n\t}\n}\n\n";

print OUTC "void free_node(Node *node)\n" .
	   "{\n" .
	   "\tg_return_if_fail(node != NULL);\n" .
	   "\tg_return_if_fail(node->type >= 0 && node->type < LAST_NODE_TYPE);\n" .
	   "\tswitch(node->type) {\n";
foreach $t (sort keys %typestruct) {
	print OUTC "\tcase " . uc($t) . "_NODE: free_" . lc($t) . " (($t *)node); return;\n";
}
print OUTC "\tdefault: return;\n\t}\n}\n\n";

print OUTC "GList * copy_node_list(GList *nodes)\n" .
	   "{\n" .
	   "\tGList *li;\n" .
	   "\tnodes = g_list_copy(nodes);\n" .
	   "\tfor(li = nodes; li != NULL; li = li->next) {\n" .
	   "\t\tli->data = copy_node(li->data);\n" .
	   "\t}\n" .
	   "\treturn nodes;\n" .
	   "}\n\n";

print OUTC "void free_node_list(GList *nodes)\n" .
	   "{\n" .
	   "\tGList *li;\n" .
	   "\tfor(li = nodes; li != NULL; li = li->next) {\n" .
	   "\t\tfree_node(li->data);\n" .
	   "\t}\n" .
	   "\tg_list_free(nodes);\n" .
	   "}\n\n";

close(OUTC);
