X-Git-Url: http://git.draconx.ca/gitweb/gob-dx.git/blobdiff_plain/714b58ab4606ed4d40cec3702cb378938f8c883f..7231d76fbf4ae0b501af648e1216b88714aa7353:/src/generate_treefuncs.pl

diff --git a/src/generate_treefuncs.pl b/src/generate_treefuncs.pl
index de6c4b6..31d9151 100755
--- a/src/generate_treefuncs.pl
+++ b/src/generate_treefuncs.pl
@@ -1,8 +1,8 @@
 #!/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");
+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";
@@ -14,37 +14,36 @@ $typeenums = "enum {\n";
 
 $typename = "";
 %typestruct = ();
-%newfunc = ();
-%newfunc_prot = ();
 %freefunc = ();
 %freefunc_prot = ();
 %copyfunc = ();
 %copyfunc_prot = ();
+%setfunc = ();
+%setfunc_prot = ();
+
+$quarks = "static gboolean quarks_set_up = FALSE;\n" .
+	"static GHashTable *quark_ht;\n" .
+	"enum {\n\tQUARK_0,\n";
+$setupquarks = "static void\nensure_quarks (void)\n{\n" .
+		"\tif (quarks_set_up)\n\t\treturn;\n" .
+		"\tquark_ht = g_hash_table_new (g_str_hash, g_str_equal);\n" .
+		"\tquarks_set_up = TRUE;\n";
+%got_quarks = ();
 
 $var = "";
 $type = "";
 $copy = "";
 $free = "";
+$steal = 0;
 
 $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 "") {
+	if ($copy ne "") {
 		$tmp = $copy;
 		$tmp =~ s/__VAL__/self->$var/g;
 		$tmp =~ s/__LVAL__/new->$var/g;
@@ -52,16 +51,58 @@ sub end_var {
 	} else {
 		$copyfunc{$typename} .= "\tnew->$var = self->$var;\n";
 	}
-	if($free ne "") {
+	if ($free ne "") {
 		$tmp = $free;
 		$tmp =~ s/__VAL__/self->$var/g;
 		$freefunc{$typename} .= "\t$tmp\n";
 	}
+
+	if ( ! $got_quarks{$var}) {
+		$quarks .= "\tQUARK_$var,\n";
+		$setupquarks .= "\tg_hash_table_insert (quark_ht, \"$var\", " .
+			"GINT_TO_POINTER (QUARK_$var));\n";
+		$got_quarks{$var} = 1;
+	}
+	if ($steal && ! $got_quarks{$var . ":steal"}) {
+		$quarks .= "\tQUARK_$var" . "_STEAL,\n";
+		$setupquarks .= "\tg_hash_table_insert (quark_ht, \"$var" .
+			":steal\", " .
+			"GINT_TO_POINTER (QUARK_$var" . "_STEAL));\n";
+		$got_quarks{$var . ":steal"} = 1;
+	}
+
+	$setfunc{$typename} .= "\t\tcase QUARK_$var: {\n";
+	$setfunc{$typename} .= "\t\t\t$type $var = va_arg (__ap, $type);\n";
+	if ($free ne "") {
+		$setfunc{$typename} .= "\t\t\t$type __old_value = self->$var;\n";
+	}
+
+	if ($copy ne "") {
+		$tmp = $copy;
+		$tmp =~ s/__VAL__/$var/g;
+		$tmp =~ s/__LVAL__/self->$var/g;
+		$setfunc{$typename} .= "\t\t\t$tmp\n";
+	} else {
+		$setfunc{$typename} .= "\t\t\tself->$var = $var;\n";
+	}
+	if ($free ne "") {
+		$tmp = $free;
+		$tmp =~ s/__VAL__/__old_value/g;
+		$setfunc{$typename} .= "\t\t\t$tmp\n";
+	}
+	$setfunc{$typename} .= "\t\t\tbreak;\n\t\t}\n";
+
+	if ($steal) {
+		$setfunc{$typename} .= "\t\tcase QUARK_$var" . "_STEAL: {\n";
+		$setfunc{$typename} .= "\t\t\t$type $var = va_arg (__ap, $type);\n";
+		$setfunc{$typename} .= "\t\t\tself->$var = $var;\n";
+		$setfunc{$typename} .= "\t\t\tbreak;\n\t\t}\n";
+	}
 }
 
-while(<FILE>) {
-	if($inheadercode) {
-		if(/^ENDHEADER$/) {
+while (<FILE>) {
+	if ($inheadercode) {
+		if (/^ENDHEADER$/) {
 			$inheadercode = 0;
 			next;
 		}
@@ -71,117 +112,132 @@ while(<FILE>) {
 		
 	s/#.*$//;
 
-	if(/^[ \t]*HEADER[ \t]*$/) {
+	if (/^[ \t]*HEADER[ \t]*$/) {
 		$inheadercode = 1;
 		next;
 	}
 
-	if(/^[ \t]*CLASS[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	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";
+		$typestruct{$typename} = "struct _$typename {\n\tNodeType type;\n";
+		$copyfunc_prot{$typename} = "static $typename *\ncopy_$lct ($typename * self)";
+		$setfunc_prot{$typename} = "static void\nsetv_$lct ($typename * self, va_list __ap)";
+		$freefunc_prot{$typename} = "void\nfree_$lct ($typename * self)";
+
+		$setfunc{$typename} = "{\n" .
+			"\tint quark;\n" .
+			"\tconst char *arg;\n" .
+			"\tensure_quarks ();\n" .
+			"\twhile ((arg = va_arg (__ap, char *)) != NULL) {\n" .
+			"\t\tquark = GPOINTER_TO_INT (g_hash_table_lookup (quark_ht, arg));\n" .
+			"\t\tswitch (quark) {\n";
 		$copyfunc{$typename} = "{\n" .
 					"\t$typename * new;\n" .
-					"\tg_return_val_if_fail(self != NULL, NULL);\n" .
-					"\tg_return_val_if_fail(self->type == $uct"."_NODE, NULL);\n" .
+					"\tg_return_val_if_fail (self != NULL, NULL);\n" .
+					"\tg_return_val_if_fail (self->type == $uct"."_NODE, NULL);\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";
+		$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 "") {
+	if ($typename eq "") {
 		next;
 	}
 	
 	#some predefined VARIABLE types
-	if(/^[ \t]*INT[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	if (/^[ \t]*INT[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 		$var = $1;
 		$type = "int";
 		$copy = "__LVAL__ = __VAL__;";
 		$free = "";
+		$steal = 0;
 		end_var;
 		next;
-	} elsif(/^[ \t]*BOOL[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	} elsif (/^[ \t]*BOOL[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 		$var = $1;
 		$type = "gboolean";
 		$copy = "__LVAL__ = __VAL__;";
 		$free = "";
+		$steal = 0;
 		end_var;
 		next;
-	} elsif(/^[ \t]*STRING[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	} 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__);";
+		$copy = "__LVAL__ = g_strdup (__VAL__);";
+		$free = "g_free (__VAL__);";
+		$steal = 1;
 		end_var;
 		next;
-	} elsif(/^[ \t]*STRINGLIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	} 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__);";
+		$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__);";
+		$steal = 1;
 		end_var;
 		next;
-	} elsif(/^[ \t]*NODELIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	} 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__);";
+		$copy = "__LVAL__ = node_list_copy (__VAL__);";
+		$free = "node_list_free (__VAL__);";
+		$steal = 1;
 		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]*$/) {
+	} 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__);";
+		$copy = "__LVAL__ = copy_type (__VAL__);";
+		$free = "free_type (__VAL__);";
+		$steal = 1;
 		end_var;
 		next;
 	#generic variable type
-	} elsif(/^[ \t]*VAR[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
+	} elsif (/^[ \t]*VAR[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 		$var = $1;
 		$type = "int";
 		$copy = "__LVAL__ = __VAL__;";
 		$free = "";
+		$steal = 0;
 		next;
-	} elsif(/^[ \t]*CTYPE[ \t]+(.+)[ \t]*$/) {
+	} elsif (/^[ \t]*CTYPE[ \t]+(.+)[ \t]*$/) {
 		$type = $1;
 		next;
-	} elsif(/^[ \t]*COPY[ \t]+(.+)$/) {
+	} elsif (/^[ \t]*COPY[ \t]+(.+)$/) {
 		$copy = $1;
+		$steal = 1;
 		next;
-	} elsif(/^[ \t]*FREE[ \t]+(.+)$/) {
+	} elsif (/^[ \t]*FREE[ \t]+(.+)$/) {
 		$free = $1;
+		$steal = 1;
 		next;
-	} elsif(/^[ \t]*ENDVAR[ \t]*$/) {
+	} elsif (/^[ \t]*ENDVAR[ \t]*$/) {
 		end_var;
 		next;
-	} elsif(/^[ \t]*ENDCLASS[ \t]*$/) {
+	} 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}";
+		$freefunc{$typename} .= "\tg_free (self);\n}";
+		$setfunc{$typename} .= "\t\tdefault:\n" .
+			"\t\t\tg_warning (\"Argument named '" . $typename . "::\%s' does not exist\", arg);\n" .
+			"\t\t\tbreak;\n" .
+			"\t\t}\n" .
+			"\t}\n" .
+			"}";
 		$typename = "";
 		next;
 	} else {
@@ -191,10 +247,11 @@ while(<FILE>) {
 
 $typeenums .= "\tLAST_NODE_TYPE\n};";
 
-print OUTH "\n#ifndef _TREEFUNCS_H_\n";
-print OUTH "\n#define _TREEFUNCS_H_\n";
+print OUTH "\n#ifndef TREEFUNCS_H\n";
+print OUTH "#define TREEFUNCS_H\n";
 
 print OUTH "\n$headercode\n\n";
+print OUTH "typedef long NodeType;\n";
 print OUTH "$typeenums\n\n";
 print OUTH "$typedefs\n\n";
 
@@ -202,11 +259,11 @@ foreach $t (sort keys %typestruct) {
 	print OUTH "$typestruct{$t}\n\n";
 }
 
-print OUTH "union _Node {\n\tint type;\n";
+print OUTH "union _Node {\n\tNodeType type;\n";
 
 foreach $t (sort keys %typestruct) {
 	$foo = lc $t;
-	if($foo eq "type") {
+	if ($foo eq "type") {
 		print OUTH "\t$t _type;\n";
 	} else {
 		print OUTH "\t$t $foo;\n";
@@ -214,39 +271,43 @@ foreach $t (sort keys %typestruct) {
 }
 print OUTH "};\n\n";
 
+print OUTH "\n/* General copy/free functions */\n";
+print OUTH "Node * node_copy (Node *node);\n";
+print OUTH "void node_free (Node *node);\n\n";
+print OUTH "GList * node_list_copy (GList *nodes);\n";
+print OUTH "void node_list_free (GList *nodes);\n";
 
-print OUTH "/* New functions */\n";
+print OUTH "\n/* Node new/set functions */\n";
+print OUTH "Node * node_new (NodeType type, ...);\n";
+print OUTH "void node_set (Node *node, ...);\n\n";
 
-foreach $t (sort keys %newfunc_prot) {
-	print OUTH "$newfunc_prot{$t};\n";
-}
+print OUTH "\n#endif /* TREEFUNCS_H */\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";
+close (OUTH);
+
+print OUTC "#include <glib.h>\n";
+print OUTC "#include <stdarg.h>\n";
+print OUTC "#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";
 
-print OUTH "\n/* Copy functions */\n";
 foreach $t (sort keys %copyfunc_prot) {
-	print OUTH "$copyfunc_prot{$t};\n";
+	print OUTC "$copyfunc_prot{$t};\n";
 }
-print OUTH "\n/* Free functions */\n";
+print OUTC "\n";
+
 foreach $t (sort keys %freefunc_prot) {
-	print OUTH "$freefunc_prot{$t};\n";
+	print OUTC "$freefunc_prot{$t};\n";
 }
+print OUTC "\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 %setfunc_prot) {
+	print OUTC "$setfunc_prot{$t};\n";
 }
+print OUTC "\n";
+
+print OUTC $quarks . "\tQUARK_LAST\n};\n\n";
+print OUTC $setupquarks . "}\n\n";
 
 foreach $t (sort keys %copyfunc_prot) {
 	print OUTC "$copyfunc_prot{$t}\n$copyfunc{$t}\n\n";
@@ -256,43 +317,84 @@ foreach $t (sort keys %freefunc_prot) {
 	print OUTC "$freefunc_prot{$t}\n$freefunc{$t}\n\n";
 }
 
-print OUTC "Node * copy_node(Node *node)\n" .
+foreach $t (sort keys %setfunc_prot) {
+	print OUTC "$setfunc_prot{$t}\n$setfunc{$t}\n\n";
+}
+
+print OUTC "Node *\nnode_copy (Node *node)\n" .
 	   "{\n" .
-	   "\tg_return_val_if_fail(node != NULL, NULL);\n" .
-	   "\tg_return_val_if_fail(node->type >= 0 && node->type < LAST_NODE_TYPE, NULL);\n" .
-	   "\tswitch(node->type) {\n";
+	   "\tg_return_val_if_fail (node != NULL, NULL);\n" .
+	   "\tg_return_val_if_fail (node->type >= 0 && node->type < LAST_NODE_TYPE, NULL);\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 "\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" .
+print OUTC "static void\nnode_setv (Node *node, va_list __ap)\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: setv_" . lc ($t) . " (($t *)node, __ap); break;\n";
+}
+print OUTC "\tdefault: break;\n\t}\n}\n\n";
+
+print OUTC "void\nnode_set (Node *node, ...)\n" .
+	   "{\n" .
+	   "\tva_list __ap;\n" .
+	   "\tva_start (__ap, node);\n" .
+	   "\tnode_setv (node, __ap);\n" .
+	   "\tva_end (__ap);\n" .
+	   "}\n\n";
+
+print OUTC "Node *\nnode_new (NodeType type, ...)\n" .
+	   "{\n" .
+	   "\tva_list __ap;\n" .
+	   "\tNode *node = NULL;\n" .
+	   "\tva_start (__ap, type);\n" .
+	   "\tg_return_val_if_fail (type >= 0 && type < LAST_NODE_TYPE, NULL);\n" .
+	   "\tswitch (type) {\n";
+foreach $t (sort keys %typestruct) {
+	print OUTC "\tcase " . uc ($t) . "_NODE:\n" .
+		"\t\tnode = (Node *)g_new0 ($t, 1);\n" .
+		"\t\tnode->type = type;\n" .
+		"\t\tsetv_" . lc ($t) . " (($t *)node, __ap);\n" .
+		"\t\tbreak;\n";
+}
+print OUTC "\tdefault: break;\n\t}\n" .
+	   "\tva_end (__ap);\n" .
+	   "\treturn node;\n" .
+	   "}\n\n";
+
+print OUTC "void\nnode_free (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";
+	   "\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 "\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" .
+print OUTC "GList *\nnode_list_copy (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" .
+	   "\tnodes = g_list_copy (nodes);\n" .
+	   "\tfor (li = nodes; li != NULL; li = li->next) {\n" .
+	   "\t\tli->data = node_copy (li->data);\n" .
 	   "\t}\n" .
 	   "\treturn nodes;\n" .
 	   "}\n\n";
 
-print OUTC "void free_node_list(GList *nodes)\n" .
+print OUTC "void\nnode_list_free (GList *nodes)\n" .
 	   "{\n" .
 	   "\tGList *li;\n" .
-	   "\tfor(li = nodes; li != NULL; li = li->next) {\n" .
-	   "\t\tfree_node(li->data);\n" .
+	   "\tfor (li = nodes; li != NULL; li = li->next) {\n" .
+	   "\t\tnode_free (li->data);\n" .
 	   "\t}\n" .
-	   "\tg_list_free(nodes);\n" .
+	   "\tg_list_free (nodes);\n" .
 	   "}\n\n";
 
-close(OUTC);
+close (OUTC);