src/generate_treefuncs.pl

   1 #!/usr/bin/perl -w
   2
   3 open(FILE, "treefuncs.def") || die("Can't open treefuncs.def");
   4 open(OUTC, ">treefuncs.c") || die("Can't open treefuncs.c");
   5 open(OUTH, ">treefuncs.h") || die("Can't open treefuncs.h");
   6
   7 print OUTC  "/* Generated by generate_treefuncs.pl from treefuncs.def!\n";
   8 print OUTC " * Do not edit by hand! */\n\n";
   9 print OUTH "/* Generated by generate_treefuncs.pl from treefuncs.def!\n";
  10 print OUTH " * Do not edit by hand! */\n\n";
  11
  12 $typedefs = "typedef union _Node Node;\n";
  13 $typeenums = "enum {\n";
  14
  15 $typename = "";
  16 %typestruct = ();
  17 %newfunc = ();
  18 %newfunc_prot = ();
  19 %freefunc = ();
  20 %freefunc_prot = ();
  21 %copyfunc = ();
  22 %copyfunc_prot = ();
  23
  24 $var = "";
  25 $type = "";
  26 $copy = "";
  27 $free = "";
  28
  29 $headercode = "";
  30
  31 $inheadercode = 0;
  32
  33 $vars = 0;
  34
  35 sub end_var {
  36         $typestruct{$typename} .= "\t$type $var;\n";
  37
  38         if($vars == 0) {
  39                 $newfunc_prot{$typename} .= "$type $var";
  40         } else {
  41                 $newfunc_prot{$typename} .= ", $type $var";
  42         }
  43         $vars++;
  44
  45         $newfunc{$typename} .= "\tself->$var = $var;\n";
  46
  47         if($copy ne "") {
  48                 $tmp = $copy;
  49                 $tmp =~ s/__VAL__/self->$var/g;
  50                 $tmp =~ s/__LVAL__/new->$var/g;
  51                 $copyfunc{$typename} .= "\t$tmp\n";
  52         } else {
  53                 $copyfunc{$typename} .= "\tnew->$var = self->$var;\n";
  54         }
  55         if($free ne "") {
  56                 $tmp = $free;
  57                 $tmp =~ s/__VAL__/self->$var/g;
  58                 $freefunc{$typename} .= "\t$tmp\n";
  59         }
  60 }
  61
  62 while(<FILE>) {
  63         if($inheadercode) {
  64                 if(/^ENDHEADER$/) {
  65                         $inheadercode = 0;
  66                         next;
  67                 }
  68                 $headercode .= $_;
  69                 next;
  70         }
  71
  72         s/#.*$//;
  73
  74         if(/^[ \t]*HEADER[ \t]*$/) {
  75                 $inheadercode = 1;
  76                 next;
  77         }
  78
  79         if(/^[ \t]*CLASS[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
  80                 $typename = $1;
  81                 $lct = lc $typename;
  82                 $uct = uc $typename;
  83
  84                 $vars = 0;
  85
  86                 $typeenums .= "\t$uct"."_NODE,\n";
  87
  88                 $typedefs .= "typedef struct _$typename $typename;\n";
  89
  90                 $typestruct{$typename} = "struct _$typename {\n\tint type;\n";
  91                 $newfunc_prot{$typename} = "Node * new_$lct (";
  92                 $copyfunc_prot{$typename} = "$typename * copy_$lct ($typename * self)";
  93                 $freefunc_prot{$typename} = "void free_$lct ($typename * self)";
  94
  95                 $newfunc{$typename} = "{\n" .
  96                                         "\t$typename * self = g_new0($typename, 1);\n" .
  97                                         "\tself->type = $uct"."_NODE;\n";
  98                 $copyfunc{$typename} = "{\n" .
  99                                         "\t$typename * new;\n" .
 100                                         "\tg_return_val_if_fail(self != NULL, NULL);\n" .
 101                                         "\tg_return_val_if_fail(self->type == $uct"."_NODE, NULL);\n" .
 102                                         "\tnew = g_new0($typename, 1);\n" .
 103                                         "\tnew->type = $uct"."_NODE;\n";
 104                 $freefunc{$typename} = "{\n\tg_return_if_fail(self != NULL);\n" .
 105                                         "\tg_return_if_fail(self->type == $uct"."_NODE);\n";
 106
 107                 next;
 108         }
 109
 110         #ignore everything until we get some typename
 111         if($typename eq "") {
 112                 next;
 113         }
 114
 115         #some predefined VARIABLE types
 116         if(/^[ \t]*INT[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 117                 $var = $1;
 118                 $type = "int";
 119                 $copy = "__LVAL__ = __VAL__;";
 120                 $free = "";
 121                 end_var;
 122                 next;
 123         } elsif(/^[ \t]*BOOL[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 124                 $var = $1;
 125                 $type = "gboolean";
 126                 $copy = "__LVAL__ = __VAL__;";
 127                 $free = "";
 128                 end_var;
 129                 next;
 130         } elsif(/^[ \t]*STRING[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 131                 $var = $1;
 132                 $type = "char *";
 133                 $copy = "__LVAL__ = g_strdup(__VAL__);";
 134                 $free = "g_free(__VAL__);";
 135                 end_var;
 136                 next;
 137         } elsif(/^[ \t]*STRINGLIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 138                 $var = $1;
 139                 $type = "GList *";
 140                 $copy = "__LVAL__ = g_list_copy(__VAL__); COPY_LIST_VALS(__LVAL__, g_strdup);";
 141                 $free = "g_list_foreach(__VAL__, (GFunc)g_free, NULL); g_list_free(__VAL__);";
 142                 end_var;
 143                 next;
 144         } elsif(/^[ \t]*NODELIST[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 145                 $var = $1;
 146                 $type = "GList *";
 147                 $copy = "__LVAL__ = copy_node_list(__VAL__);";
 148                 $free = "free_node_list(__VAL__);";
 149                 end_var;
 150                 next;
 151         #We assume one of the classes we are creating is named Type
 152         } elsif(/^[ \t]*TYPE[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 153                 $var = $1;
 154                 $type = "Type *";
 155                 $copy = "__LVAL__ = copy_type(__VAL__);";
 156                 $free = "free_type(__VAL__);";
 157                 end_var;
 158                 next;
 159         #generic variable type
 160         } elsif(/^[ \t]*VAR[ \t]+([_A-Za-z][A-Za-z_0-9]+)[ \t]*$/) {
 161                 $var = $1;
 162                 $type = "int";
 163                 $copy = "__LVAL__ = __VAL__;";
 164                 $free = "";
 165                 next;
 166         } elsif(/^[ \t]*CTYPE[ \t]+(.+)[ \t]*$/) {
 167                 $type = $1;
 168                 next;
 169         } elsif(/^[ \t]*COPY[ \t]+(.+)$/) {
 170                 $copy = $1;
 171                 next;
 172         } elsif(/^[ \t]*FREE[ \t]+(.+)$/) {
 173                 $free = $1;
 174                 next;
 175         } elsif(/^[ \t]*ENDVAR[ \t]*$/) {
 176                 end_var;
 177                 next;
 178         } elsif(/^[ \t]*ENDCLASS[ \t]*$/) {
 179                 $typestruct{$typename} .= "};";
 180                 $newfunc_prot{$typename} .= ")";
 181
 182                 $newfunc{$typename} .= "\treturn (Node *)self;\n}";
 183                 $copyfunc{$typename} .= "\treturn new;\n}";
 184                 $freefunc{$typename} .= "\tg_free(self);\n}";
 185                 $typename = "";
 186                 next;
 187         } else {
 188                 next;
 189         }
 190 }
 191
 192 $typeenums .= "\tLAST_NODE_TYPE\n};";
 193
 194 print OUTH "\n#ifndef _TREEFUNCS_H_\n";
 195 print OUTH "\n#define _TREEFUNCS_H_\n";
 196
 197 print OUTH "\n$headercode\n\n";
 198 print OUTH "$typeenums\n\n";
 199 print OUTH "$typedefs\n\n";
 200
 201 foreach $t (sort keys %typestruct) {
 202         print OUTH "$typestruct{$t}\n\n";
 203 }
 204
 205 print OUTH "union _Node {\n\tint type;\n";
 206
 207 foreach $t (sort keys %typestruct) {
 208         $foo = lc $t;
 209         if($foo eq "type") {
 210                 print OUTH "\t$t _type;\n";
 211         } else {
 212                 print OUTH "\t$t $foo;\n";
 213         }
 214 }
 215 print OUTH "};\n\n";
 216
 217
 218 print OUTH "/* New functions */\n";
 219
 220 foreach $t (sort keys %newfunc_prot) {
 221         print OUTH "$newfunc_prot{$t};\n";
 222 }
 223
 224 print OUTH "\n/* General copy/free functions */\n";
 225 print OUTH "Node * copy_node(Node *node);\n";
 226 print OUTH "void free_node(Node *node);\n\n";
 227 print OUTH "GList * copy_node_list(GList *nodes);\n";
 228 print OUTH "void free_node_list(GList *nodes);\n";
 229
 230 print OUTH "\n/* Copy functions */\n";
 231 foreach $t (sort keys %copyfunc_prot) {
 232         print OUTH "$copyfunc_prot{$t};\n";
 233 }
 234 print OUTH "\n/* Free functions */\n";
 235 foreach $t (sort keys %freefunc_prot) {
 236         print OUTH "$freefunc_prot{$t};\n";
 237 }
 238
 239 print OUTH "\n#endif /*_TREEFUNCS_H_*/\n";
 240
 241 close(OUTH);
 242
 243 print OUTC "#include <glib.h>\n#include \"treefuncs.h\"\n\n";
 244 print OUTC "#define COPY_LIST_VALS(list,func) " .
 245         "{ GList *li; for(li=(list);li;li=li->next) { li->data=func(li->data); } }\n\n";
 246
 247 foreach $t (sort keys %newfunc_prot) {
 248         print OUTC "$newfunc_prot{$t}\n$newfunc{$t}\n\n";
 249 }
 250
 251 foreach $t (sort keys %copyfunc_prot) {
 252         print OUTC "$copyfunc_prot{$t}\n$copyfunc{$t}\n\n";
 253 }
 254
 255 foreach $t (sort keys %freefunc_prot) {
 256         print OUTC "$freefunc_prot{$t}\n$freefunc{$t}\n\n";
 257 }
 258
 259 print OUTC "Node * copy_node(Node *node)\n" .
 260            "{\n" .
 261            "\tg_return_val_if_fail(node != NULL, NULL);\n" .
 262            "\tg_return_val_if_fail(node->type >= 0 && node->type < LAST_NODE_TYPE, NULL);\n" .
 263            "\tswitch(node->type) {\n";
 264 foreach $t (sort keys %typestruct) {
 265         print OUTC "\tcase " . uc($t) . "_NODE: return (Node *)copy_" . lc($t) . " (($t *)node);\n";
 266 }
 267 print OUTC "\tdefault: return NULL;\n\t}\n}\n\n";
 268
 269 print OUTC "void free_node(Node *node)\n" .
 270            "{\n" .
 271            "\tg_return_if_fail(node != NULL);\n" .
 272            "\tg_return_if_fail(node->type >= 0 && node->type < LAST_NODE_TYPE);\n" .
 273            "\tswitch(node->type) {\n";
 274 foreach $t (sort keys %typestruct) {
 275         print OUTC "\tcase " . uc($t) . "_NODE: free_" . lc($t) . " (($t *)node); return;\n";
 276 }
 277 print OUTC "\tdefault: return;\n\t}\n}\n\n";
 278
 279 print OUTC "GList * copy_node_list(GList *nodes)\n" .
 280            "{\n" .
 281            "\tGList *li;\n" .
 282            "\tnodes = g_list_copy(nodes);\n" .
 283            "\tfor(li = nodes; li != NULL; li = li->next) {\n" .
 284            "\t\tli->data = copy_node(li->data);\n" .
 285            "\t}\n" .
 286            "\treturn nodes;\n" .
 287            "}\n\n";
 288
 289 print OUTC "void free_node_list(GList *nodes)\n" .
 290            "{\n" .
 291            "\tGList *li;\n" .
 292            "\tfor(li = nodes; li != NULL; li = li->next) {\n" .
 293            "\t\tfree_node(li->data);\n" .
 294            "\t}\n" .
 295            "\tg_list_free(nodes);\n" .
 296            "}\n\n";
 297
 298 close(OUTC);