/trunk/Source/Modules/chicken.cxx

   1/* -----------------------------------------------------------------------------
   2 * This file is part of SWIG, which is licensed as a whole under version 3 
   3 * (or any later version) of the GNU General Public License. Some additional
   4 * terms also apply to certain portions of SWIG. The full details of the SWIG
   5 * license and copyrights can be found in the LICENSE and COPYRIGHT files
   6 * included with the SWIG source code as distributed by the SWIG developers
   7 * and at http://www.swig.org/legal.html.
   8 *
   9 * chicken.cxx
  10 *
  11 * CHICKEN language module for SWIG.
  12 * ----------------------------------------------------------------------------- */
  13
  14char cvsroot_chicken_cxx[] = "$Id: chicken.cxx 12830 2011-10-30 21:51:50Z wsfulton $";
  15
  16#include "swigmod.h"
  17
  18#include <ctype.h>
  19
  20static const char *usage = (char *) "\
  21\
  22CHICKEN Options (available with -chicken)\n\
  23     -closprefix <prefix>   - Prepend <prefix> to all clos identifiers\n\
  24     -noclosuses            - Do not (declare (uses ...)) in scheme file\n\
  25     -nocollection          - Do not register pointers with chicken garbage\n\
  26                              collector and export destructors\n\
  27     -nounit                - Do not (declare (unit ...)) in scheme file\n\
  28     -proxy                 - Export TinyCLOS class definitions\n\
  29     -unhideprimitive       - Unhide the primitive: symbols\n\
  30     -useclassprefix        - Prepend the class name to all clos identifiers\n\
  31\n";
  32
  33static char *module = 0;
  34static char *chicken_path = (char *) "chicken";
  35static int num_methods = 0;
  36
  37static File *f_begin = 0;
  38static File *f_runtime = 0;
  39static File *f_header = 0;
  40static File *f_wrappers = 0;
  41static File *f_init = 0;
  42static String *chickentext = 0;
  43static String *closprefix = 0;
  44static String *swigtype_ptr = 0;
  45
  46
  47static String *f_sym_size = 0;
  48
  49/* some options */
  50static int declare_unit = 1;
  51static int no_collection = 0;
  52static int clos_uses = 1;
  53
  54/* C++ Support + Clos Classes */
  55static int clos = 0;
  56static String *c_class_name = 0;
  57static String *class_name = 0;
  58static String *short_class_name = 0;
  59
  60static int in_class = 0;
  61static int have_constructor = 0;
  62static bool exporting_destructor = false;
  63static bool exporting_constructor = false;
  64static String *constructor_name = 0;
  65static String *member_name = 0;
  66
  67/* sections of the .scm code */
  68static String *scm_const_defs = 0;
  69static String *clos_class_defines = 0;
  70static String *clos_methods = 0;
  71
  72/* Some clos options */
  73static int useclassprefix = 0;
  74static String *clossymnameprefix = 0;
  75static int hide_primitive = 1;
  76static Hash *primitive_names = 0;
  77
  78/* Used for overloading constructors */
  79static int has_constructor_args = 0;
  80static List *constructor_arg_types = 0;
  81static String *constructor_dispatch = 0;
  82
  83static Hash *overload_parameter_lists = 0;
  84
  85class CHICKEN:public Language {
  86public:
  87
  88  virtual void main(int argc, char *argv[]);
  89  virtual int top(Node *n);
  90  virtual int functionWrapper(Node *n);
  91  virtual int variableWrapper(Node *n);
  92  virtual int constantWrapper(Node *n);
  93  virtual int classHandler(Node *n);
  94  virtual int memberfunctionHandler(Node *n);
  95  virtual int membervariableHandler(Node *n);
  96  virtual int constructorHandler(Node *n);
  97  virtual int destructorHandler(Node *n);
  98  virtual int validIdentifier(String *s);
  99  virtual int staticmembervariableHandler(Node *n);
 100  virtual int staticmemberfunctionHandler(Node *n);
 101  virtual int importDirective(Node *n);
 102
 103protected:
 104  void addMethod(String *scheme_name, String *function);
 105  /* Return true iff T is a pointer type */
 106  int isPointer(SwigType *t);
 107  void dispatchFunction(Node *n);
 108
 109  String *chickenNameMapping(String *, const_String_or_char_ptr );
 110  String *chickenPrimitiveName(String *);
 111
 112  String *runtimeCode();
 113  String *defaultExternalRuntimeFilename();
 114  String *buildClosFunctionCall(List *types, const_String_or_char_ptr closname, const_String_or_char_ptr funcname);
 115};
 116
 117/* -----------------------------------------------------------------------
 118 * swig_chicken()    - Instantiate module
 119 * ----------------------------------------------------------------------- */
 120
 121static Language *new_swig_chicken() {
 122  return new CHICKEN();
 123}
 124
 125extern "C" {
 126  Language *swig_chicken(void) {
 127    return new_swig_chicken();
 128  }
 129}
 130
 131void CHICKEN::main(int argc, char *argv[]) {
 132  int i;
 133
 134  SWIG_library_directory(chicken_path);
 135
 136  // Look for certain command line options
 137  for (i = 1; i < argc; i++) {
 138    if (argv[i]) {
 139      if (strcmp(argv[i], "-help") == 0) {
 140	fputs(usage, stdout);
 141	SWIG_exit(0);
 142      } else if (strcmp(argv[i], "-proxy") == 0) {
 143	clos = 1;
 144	Swig_mark_arg(i);
 145      } else if (strcmp(argv[i], "-closprefix") == 0) {
 146	if (argv[i + 1]) {
 147	  clossymnameprefix = NewString(argv[i + 1]);
 148	  Swig_mark_arg(i);
 149	  Swig_mark_arg(i + 1);
 150	  i++;
 151	} else {
 152	  Swig_arg_error();
 153	}
 154      } else if (strcmp(argv[i], "-useclassprefix") == 0) {
 155	useclassprefix = 1;
 156	Swig_mark_arg(i);
 157      } else if (strcmp(argv[i], "-unhideprimitive") == 0) {
 158	hide_primitive = 0;
 159	Swig_mark_arg(i);
 160      } else if (strcmp(argv[i], "-nounit") == 0) {
 161	declare_unit = 0;
 162	Swig_mark_arg(i);
 163      } else if (strcmp(argv[i], "-noclosuses") == 0) {
 164	clos_uses = 0;
 165	Swig_mark_arg(i);
 166      } else if (strcmp(argv[i], "-nocollection") == 0) {
 167	no_collection = 1;
 168	Swig_mark_arg(i);
 169      }
 170    }
 171  }
 172
 173  if (!clos)
 174    hide_primitive = 0;
 175
 176  // Add a symbol for this module
 177  Preprocessor_define("SWIGCHICKEN 1", 0);
 178
 179  // Set name of typemaps
 180
 181  SWIG_typemap_lang("chicken");
 182
 183  // Read in default typemaps */
 184  SWIG_config_file("chicken.swg");
 185  allow_overloading();
 186}
 187
 188int CHICKEN::top(Node *n) {
 189  String *chicken_filename = NewString("");
 190  File *f_scm;
 191  String *scmmodule;
 192
 193  /* Initialize all of the output files */
 194  String *outfile = Getattr(n, "outfile");
 195
 196  f_begin = NewFile(outfile, "w", SWIG_output_files());
 197  if (!f_begin) {
 198    FileErrorDisplay(outfile);
 199    SWIG_exit(EXIT_FAILURE);
 200  }
 201  f_runtime = NewString("");
 202  f_init = NewString("");
 203  f_header = NewString("");
 204  f_wrappers = NewString("");
 205  chickentext = NewString("");
 206  closprefix = NewString("");
 207  f_sym_size = NewString("");
 208  primitive_names = NewHash();
 209  overload_parameter_lists = NewHash();
 210
 211  /* Register file targets with the SWIG file handler */
 212  Swig_register_filebyname("header", f_header);
 213  Swig_register_filebyname("wrapper", f_wrappers);
 214  Swig_register_filebyname("begin", f_begin);
 215  Swig_register_filebyname("runtime", f_runtime);
 216  Swig_register_filebyname("init", f_init);
 217
 218  Swig_register_filebyname("chicken", chickentext);
 219  Swig_register_filebyname("closprefix", closprefix);
 220
 221  clos_class_defines = NewString("");
 222  clos_methods = NewString("");
 223  scm_const_defs = NewString("");
 224
 225  Swig_banner(f_begin);
 226
 227  Printf(f_runtime, "\n");
 228  Printf(f_runtime, "#define SWIGCHICKEN\n");
 229
 230  if (no_collection)
 231    Printf(f_runtime, "#define SWIG_CHICKEN_NO_COLLECTION 1\n");
 232
 233  Printf(f_runtime, "\n");
 234
 235  /* Set module name */
 236  module = Swig_copy_string(Char(Getattr(n, "name")));
 237  scmmodule = NewString(module);
 238  Replaceall(scmmodule, "_", "-");
 239
 240  Printf(f_header, "#define SWIG_init swig_%s_init\n", module);
 241  Printf(f_header, "#define SWIG_name \"%s\"\n", scmmodule);
 242
 243  Printf(f_wrappers, "#ifdef __cplusplus\n");
 244  Printf(f_wrappers, "extern \"C\" {\n");
 245  Printf(f_wrappers, "#endif\n\n");
 246
 247  Language::top(n);
 248
 249  SwigType_emit_type_table(f_runtime, f_wrappers);
 250
 251  Printf(f_wrappers, "#ifdef __cplusplus\n");
 252  Printf(f_wrappers, "}\n");
 253  Printf(f_wrappers, "#endif\n");
 254
 255  Printf(f_init, "C_kontinue (continuation, ret);\n");
 256  Printf(f_init, "}\n\n");
 257
 258  Printf(f_init, "#ifdef __cplusplus\n");
 259  Printf(f_init, "}\n");
 260  Printf(f_init, "#endif\n");
 261
 262  Printf(chicken_filename, "%s%s.scm", SWIG_output_directory(), module);
 263  if ((f_scm = NewFile(chicken_filename, "w", SWIG_output_files())) == 0) {
 264    FileErrorDisplay(chicken_filename);
 265    SWIG_exit(EXIT_FAILURE);
 266  }
 267
 268  Swig_banner_target_lang(f_scm, ";;");
 269  Printf(f_scm, "\n");
 270
 271  if (declare_unit)
 272    Printv(f_scm, "(declare (unit ", scmmodule, "))\n\n", NIL);
 273  Printv(f_scm, "(declare \n",
 274	 tab4, "(hide swig-init swig-init-return)\n",
 275	 tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL);
 276  Printv(f_scm, "(define swig-init (##core#primitive \"swig_", module, "_init\"))\n", NIL);
 277  Printv(f_scm, "(define swig-init-return (swig-init))\n\n", NIL);
 278
 279  if (clos) {
 280    //Printf (f_scm, "(declare (uses tinyclos))\n");
 281    //New chicken versions have tinyclos as an egg
 282    Printf(f_scm, "(require-extension tinyclos)\n");
 283    Replaceall(closprefix, "$module", scmmodule);
 284    Printf(f_scm, "%s\n", closprefix);
 285    Printf(f_scm, "%s\n", clos_class_defines);
 286    Printf(f_scm, "%s\n", clos_methods);
 287  } else {
 288    Printf(f_scm, "%s\n", scm_const_defs);
 289  }
 290
 291  Printf(f_scm, "%s\n", chickentext);
 292
 293
 294  Close(f_scm);
 295  Delete(f_scm);
 296
 297  char buftmp[20];
 298  sprintf(buftmp, "%d", num_methods);
 299  Replaceall(f_init, "$nummethods", buftmp);
 300  Replaceall(f_init, "$symsize", f_sym_size);
 301
 302  if (hide_primitive)
 303    Replaceall(f_init, "$veclength", buftmp);
 304  else
 305    Replaceall(f_init, "$veclength", "0");
 306
 307  Delete(chicken_filename);
 308  Delete(chickentext);
 309  Delete(closprefix);
 310  Delete(overload_parameter_lists);
 311
 312  Delete(clos_class_defines);
 313  Delete(clos_methods);
 314  Delete(scm_const_defs);
 315
 316  /* Close all of the files */
 317  Delete(primitive_names);
 318  Delete(scmmodule);
 319  Dump(f_runtime, f_begin);
 320  Dump(f_header, f_begin);
 321  Dump(f_wrappers, f_begin);
 322  Wrapper_pretty_print(f_init, f_begin);
 323  Delete(f_header);
 324  Delete(f_wrappers);
 325  Delete(f_sym_size);
 326  Delete(f_init);
 327  Close(f_begin);
 328  Delete(f_runtime);
 329  Delete(f_begin);
 330  return SWIG_OK;
 331}
 332
 333int CHICKEN::functionWrapper(Node *n) {
 334
 335  String *name = Getattr(n, "name");
 336  String *iname = Getattr(n, "sym:name");
 337  SwigType *d = Getattr(n, "type");
 338  ParmList *l = Getattr(n, "parms");
 339
 340  Parm *p;
 341  int i;
 342  String *wname;
 343  Wrapper *f;
 344  String *mangle = NewString("");
 345  String *get_pointers;
 346  String *cleanup;
 347  String *argout;
 348  String *tm;
 349  String *overname = 0;
 350  String *declfunc = 0;
 351  String *scmname;
 352  bool any_specialized_arg = false;
 353  List *function_arg_types = NewList();
 354
 355  int num_required;
 356  int num_arguments;
 357  int have_argout;
 358
 359  Printf(mangle, "\"%s\"", SwigType_manglestr(d));
 360
 361  if (Getattr(n, "sym:overloaded")) {
 362    overname = Getattr(n, "sym:overname");
 363  } else {
 364    if (!addSymbol(iname, n))
 365      return SWIG_ERROR;
 366  }
 367
 368  f = NewWrapper();
 369  wname = NewString("");
 370  get_pointers = NewString("");
 371  cleanup = NewString("");
 372  argout = NewString("");
 373  declfunc = NewString("");
 374  scmname = NewString(iname);
 375  Replaceall(scmname, "_", "-");
 376
 377  /* Local vars */
 378  Wrapper_add_local(f, "resultobj", "C_word resultobj");
 379
 380  /* Write code to extract function parameters. */
 381  emit_parameter_variables(l, f);
 382
 383  /* Attach the standard typemaps */
 384  emit_attach_parmmaps(l, f);
 385  Setattr(n, "wrap:parms", l);
 386
 387  /* Get number of required and total arguments */
 388  num_arguments = emit_num_arguments(l);
 389  num_required = emit_num_required(l);
 390
 391  Append(wname, Swig_name_wrapper(iname));
 392  if (overname) {
 393    Append(wname, overname);
 394  }
 395  // Check for interrupts
 396  Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
 397
 398  Printv(f->def, "static ", "void ", wname, " (C_word argc, C_word closure, C_word continuation", NIL);
 399  Printv(declfunc, "void ", wname, "(C_word,C_word,C_word", NIL);
 400
 401  /* Generate code for argument marshalling */
 402  for (i = 0, p = l; i < num_arguments; i++) {
 403
 404    while (checkAttribute(p, "tmap:in:numinputs", "0")) {
 405      p = Getattr(p, "tmap:in:next");
 406    }
 407
 408    SwigType *pt = Getattr(p, "type");
 409    String *ln = Getattr(p, "lname");
 410
 411    Printf(f->def, ", C_word scm%d", i + 1);
 412    Printf(declfunc, ",C_word");
 413
 414    /* Look for an input typemap */
 415    if ((tm = Getattr(p, "tmap:in"))) {
 416      String *parse = Getattr(p, "tmap:in:parse");
 417      if (!parse) {
 418        String *source = NewStringf("scm%d", i + 1);
 419	Replaceall(tm, "$source", source);
 420	Replaceall(tm, "$target", ln);
 421	Replaceall(tm, "$input", source);
 422	Setattr(p, "emit:input", source);	/* Save the location of
 423						   the object */
 424
 425	if (Getattr(p, "wrap:disown") || (Getattr(p, "tmap:in:disown"))) {
 426	  Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
 427	} else {
 428	  Replaceall(tm, "$disown", "0");
 429	}
 430
 431	if (i >= num_required)
 432	  Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source);
 433	Printv(get_pointers, tm, "\n", NIL);
 434	if (i >= num_required)
 435	  Printv(get_pointers, "}\n", NIL);
 436
 437	if (clos) {
 438	  if (i < num_required) {
 439	    if (strcmp("void", Char(pt)) != 0) {
 440	      Node *class_node = 0;
 441	      String *clos_code = Getattr(p, "tmap:in:closcode");
 442	      class_node = classLookup(pt);
 443	      if (clos_code && class_node) {
 444		String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name"));
 445		Replaceall(class_name, "_", "-");
 446		Append(function_arg_types, class_name);
 447		Append(function_arg_types, Copy(clos_code));
 448		any_specialized_arg = true;
 449		Delete(class_name);
 450	      } else {
 451		Append(function_arg_types, "<top>");
 452		Append(function_arg_types, "$input");
 453	      }
 454	    }
 455	  }
 456	}
 457        Delete(source);
 458      }
 459
 460      p = Getattr(p, "tmap:in:next");
 461      continue;
 462    } else {
 463      Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, "Unable to use type %s as a function argument.\n", SwigType_str(pt, 0));
 464      break;
 465    }
 466  }
 467
 468  /* finish argument marshalling */
 469
 470  Printf(f->def, ") {");
 471  Printf(declfunc, ")");
 472
 473  if (num_required != num_arguments) {
 474    Append(function_arg_types, "^^##optional$$");
 475  }
 476
 477  /* First check the number of arguments is correct */
 478  if (num_arguments != num_required)
 479    Printf(f->code, "if (argc-2<%i || argc-2>%i) C_bad_argc(argc,%i);\n", num_required, num_arguments, num_required + 2);
 480  else
 481    Printf(f->code, "if (argc!=%i) C_bad_argc(argc,%i);\n", num_arguments + 2, num_arguments + 2);
 482
 483  /* Now piece together the first part of the wrapper function */
 484  Printv(f->code, get_pointers, NIL);
 485
 486  /* Insert constraint checking code */
 487  for (p = l; p;) {
 488    if ((tm = Getattr(p, "tmap:check"))) {
 489      Replaceall(tm, "$target", Getattr(p, "lname"));
 490      Printv(f->code, tm, "\n", NIL);
 491      p = Getattr(p, "tmap:check:next");
 492    } else {
 493      p = nextSibling(p);
 494    }
 495  }
 496
 497  /* Insert cleanup code */
 498  for (p = l; p;) {
 499    if ((tm = Getattr(p, "tmap:freearg"))) {
 500      Replaceall(tm, "$source", Getattr(p, "lname"));
 501      Printv(cleanup, tm, "\n", NIL);
 502      p = Getattr(p, "tmap:freearg:next");
 503    } else {
 504      p = nextSibling(p);
 505    }
 506  }
 507
 508  /* Insert argument output code */
 509  have_argout = 0;
 510  for (p = l; p;) {
 511    if ((tm = Getattr(p, "tmap:argout"))) {
 512
 513      if (!have_argout) {
 514	have_argout = 1;
 515	// Print initial argument output code
 516	Printf(argout, "SWIG_Chicken_SetupArgout\n");
 517      }
 518
 519      Replaceall(tm, "$source", Getattr(p, "lname"));
 520      Replaceall(tm, "$target", "resultobj");
 521      Replaceall(tm, "$arg", Getattr(p, "emit:input"));
 522      Replaceall(tm, "$input", Getattr(p, "emit:input"));
 523      Printf(argout, "%s", tm);
 524      p = Getattr(p, "tmap:argout:next");
 525    } else {
 526      p = nextSibling(p);
 527    }
 528  }
 529
 530  Setattr(n, "wrap:name", wname);
 531
 532  /* Emit the function call */
 533  String *actioncode = emit_action(n);
 534
 535  /* Return the function value */
 536  if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
 537    Replaceall(tm, "$source", Swig_cresult_name());
 538    Replaceall(tm, "$target", "resultobj");
 539    Replaceall(tm, "$result", "resultobj");
 540    if (GetFlag(n, "feature:new")) {
 541      Replaceall(tm, "$owner", "1");
 542    } else {
 543      Replaceall(tm, "$owner", "0");
 544    }
 545
 546    Printf(f->code, "%s", tm);
 547
 548    if (have_argout)
 549      Printf(f->code, "\nSWIG_APPEND_VALUE(resultobj);\n");
 550
 551  } else {
 552    Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(d, 0), name);
 553  }
 554  emit_return_variable(n, d, f);
 555
 556  /* Insert the argumetn output code */
 557  Printv(f->code, argout, NIL);
 558
 559  /* Output cleanup code */
 560  Printv(f->code, cleanup, NIL);
 561
 562  /* Look to see if there is any newfree cleanup code */
 563  if (GetFlag(n, "feature:new")) {
 564    if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
 565      Replaceall(tm, "$source", Swig_cresult_name());
 566      Printf(f->code, "%s\n", tm);
 567    }
 568  }
 569
 570  /* See if there is any return cleanup code */
 571  if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
 572    Replaceall(tm, "$source", Swig_cresult_name());
 573    Printf(f->code, "%s\n", tm);
 574  }
 575
 576
 577  if (have_argout) {
 578    Printf(f->code, "C_kontinue(continuation,C_SCHEME_END_OF_LIST);\n");
 579  } else {
 580    if (exporting_constructor && clos && hide_primitive) {
 581      /* Don't return a proxy, the wrapped CLOS class is the proxy */
 582      Printf(f->code, "C_kontinue(continuation,resultobj);\n");
 583    } else {
 584      // make the continuation the proxy creation function, if one exists
 585      Printv(f->code, "{\n",
 586	     "C_word func;\n",
 587	     "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
 588	     "if (C_swig_is_closurep(func))\n",
 589	     "  ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
 590	     "else\n", "  C_kontinue(continuation, resultobj);\n", "}\n", NIL);
 591    }
 592  }
 593
 594  /* Error handling code */
 595#ifdef USE_FAIL
 596  Printf(f->code, "fail:\n");
 597  Printv(f->code, cleanup, NIL);
 598  Printf(f->code, "swig_panic (\"failure in " "'$symname' SWIG function wrapper\");\n");
 599#endif
 600  Printf(f->code, "}\n");
 601
 602  /* Substitute the cleanup code */
 603  Replaceall(f->code, "$cleanup", cleanup);
 604
 605  /* Substitute the function name */
 606  Replaceall(f->code, "$symname", iname);
 607  Replaceall(f->code, "$result", "resultobj");
 608
 609  /* Dump the function out */
 610  Printv(f_wrappers, "static ", declfunc, " C_noret;\n", NIL);
 611  Wrapper_print(f, f_wrappers);
 612
 613  /* Now register the function with the interpreter.   */
 614  if (!Getattr(n, "sym:overloaded")) {
 615    if (exporting_destructor && !no_collection) {
 616      Printf(f_init, "((swig_chicken_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (swig_chicken_destructor) %s;\n", swigtype_ptr, wname);
 617    } else {
 618      addMethod(scmname, wname);
 619    }
 620
 621    /* Only export if we are not in a class, or if in a class memberfunction */
 622    if (!in_class || member_name) {
 623      String *method_def;
 624      String *clos_name;
 625      if (in_class)
 626	clos_name = NewString(member_name);
 627      else
 628	clos_name = chickenNameMapping(scmname, (char *) "");
 629
 630      if (!any_specialized_arg) {
 631	method_def = NewString("");
 632	Printv(method_def, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")", NIL);
 633      } else {
 634	method_def = buildClosFunctionCall(function_arg_types, clos_name, chickenPrimitiveName(scmname));
 635      }
 636      Printv(clos_methods, method_def, "\n", NIL);
 637      Delete(clos_name);
 638      Delete(method_def);
 639    }
 640
 641    if (have_constructor && !has_constructor_args && any_specialized_arg) {
 642      has_constructor_args = 1;
 643      constructor_arg_types = Copy(function_arg_types);
 644    }
 645  } else {
 646    /* add function_arg_types to overload hash */
 647    List *flist = Getattr(overload_parameter_lists, scmname);
 648    if (!flist) {
 649      flist = NewList();
 650      Setattr(overload_parameter_lists, scmname, flist);
 651    }
 652
 653    Append(flist, Copy(function_arg_types));
 654
 655    if (!Getattr(n, "sym:nextSibling")) {
 656      dispatchFunction(n);
 657    }
 658  }
 659
 660
 661  Delete(wname);
 662  Delete(get_pointers);
 663  Delete(cleanup);
 664  Delete(declfunc);
 665  Delete(mangle);
 666  Delete(function_arg_types);
 667  DelWrapper(f);
 668  return SWIG_OK;
 669}
 670
 671int CHICKEN::variableWrapper(Node *n) {
 672  char *name = GetChar(n, "name");
 673  char *iname = GetChar(n, "sym:name");
 674  SwigType *t = Getattr(n, "type");
 675  ParmList *l = Getattr(n, "parms");
 676
 677  String *wname = NewString("");
 678  String *mangle = NewString("");
 679  String *tm;
 680  String *tm2 = NewString("");
 681  String *argnum = NewString("0");
 682  String *arg = NewString("argv[0]");
 683  Wrapper *f;
 684  String *overname = 0;
 685  String *scmname;
 686
 687  scmname = NewString(iname);
 688  Replaceall(scmname, "_", "-");
 689
 690  Printf(mangle, "\"%s\"", SwigType_manglestr(t));
 691
 692  if (Getattr(n, "sym:overloaded")) {
 693    overname = Getattr(n, "sym:overname");
 694  } else {
 695    if (!addSymbol(iname, n))
 696      return SWIG_ERROR;
 697  }
 698
 699  f = NewWrapper();
 700
 701  /* Attach the standard typemaps */
 702  emit_attach_parmmaps(l, f);
 703  Setattr(n, "wrap:parms", l);
 704
 705  // evaluation function names
 706  Append(wname, Swig_name_wrapper(iname));
 707  if (overname) {
 708    Append(wname, overname);
 709  }
 710  Setattr(n, "wrap:name", wname);
 711
 712  // Check for interrupts
 713  Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
 714
 715  if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
 716
 717    Printv(f->def, "static ", "void ", wname, "(C_word, C_word, C_word, C_word) C_noret;\n", NIL);
 718    Printv(f->def, "static " "void ", wname, "(C_word argc, C_word closure, " "C_word continuation, C_word value) {\n", NIL);
 719
 720    Wrapper_add_local(f, "resultobj", "C_word resultobj");
 721
 722    Printf(f->code, "if (argc!=2 && argc!=3) C_bad_argc(argc,2);\n");
 723
 724    /* Check for a setting of the variable value */
 725    if (!GetFlag(n, "feature:immutable")) {
 726      Printf(f->code, "if (argc > 2) {\n");
 727      if ((tm = Swig_typemap_lookup("varin", n, name, 0))) {
 728	Replaceall(tm, "$source", "value");
 729	Replaceall(tm, "$target", name);
 730	Replaceall(tm, "$input", "value");
 731	/* Printv(f->code, tm, "\n",NIL); */
 732	emit_action_code(n, f->code, tm);
 733      } else {
 734	Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, "Unable to set variable of type %s.\n", SwigType_str(t, 0));
 735      }
 736      Printf(f->code, "}\n");
 737    }
 738
 739    String *varname;
 740    if (SwigType_istemplate((char *) name)) {
 741      varname = SwigType_namestr((char *) name);
 742    } else {
 743      varname = name;
 744    }
 745
 746    // Now return the value of the variable - regardless
 747    // of evaluating or setting.
 748    if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
 749      Replaceall(tm, "$source", varname);
 750      Replaceall(tm, "$varname", varname);
 751      Replaceall(tm, "$target", "resultobj");
 752      Replaceall(tm, "$result", "resultobj");
 753      /* Printf(f->code, "%s\n", tm); */
 754      emit_action_code(n, f->code, tm);
 755    } else {
 756      Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
 757    }
 758
 759    Printv(f->code, "{\n",
 760	   "C_word func;\n",
 761	   "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
 762	   "if (C_swig_is_closurep(func))\n",
 763	   "  ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
 764	   "else\n", "  C_kontinue(continuation, resultobj);\n", "}\n", NIL);
 765
 766    /* Error handling code */
 767#ifdef USE_FAIL
 768    Printf(f->code, "fail:\n");
 769    Printf(f->code, "swig_panic (\"failure in " "'%s' SWIG wrapper\");\n", proc_name);
 770#endif
 771    Printf(f->code, "}\n");
 772
 773    Wrapper_print(f, f_wrappers);
 774
 775    /* Now register the variable with the interpreter.   */
 776    addMethod(scmname, wname);
 777
 778    if (!in_class || member_name) {
 779      String *clos_name;
 780      if (in_class)
 781	clos_name = NewString(member_name);
 782      else
 783	clos_name = chickenNameMapping(scmname, (char *) "");
 784
 785      Node *class_node = classLookup(t);
 786      String *clos_code = Getattr(n, "tmap:varin:closcode");
 787      if (class_node && clos_code && !GetFlag(n, "feature:immutable")) {
 788	Replaceall(clos_code, "$input", "(car lst)");
 789	Printv(clos_methods, "(define (", clos_name, " . lst) (if (null? lst) (", chickenPrimitiveName(scmname), ") (",
 790	       chickenPrimitiveName(scmname), " ", clos_code, ")))\n", NIL);
 791      } else {
 792	/* Simply re-export the procedure */
 793	if (GetFlag(n, "feature:immutable") && GetFlag(n, "feature:constasvar")) {
 794	  Printv(clos_methods, "(define ", clos_name, " (", chickenPrimitiveName(scmname), "))\n", NIL);
 795	  Printv(scm_const_defs, "(set! ", scmname, " (", scmname, "))\n", NIL);
 796	} else {
 797	  Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
 798	}
 799      }
 800      Delete(clos_name);
 801    }
 802  } else {
 803    Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0));
 804  }
 805
 806  Delete(wname);
 807  Delete(argnum);
 808  Delete(arg);
 809  Delete(tm2);
 810  Delete(mangle);
 811  DelWrapper(f);
 812  return SWIG_OK;
 813}
 814
 815/* ------------------------------------------------------------
 816 * constantWrapper()
 817 * ------------------------------------------------------------ */
 818
 819int CHICKEN::constantWrapper(Node *n) {
 820
 821  char *name = GetChar(n, "name");
 822  char *iname = GetChar(n, "sym:name");
 823  SwigType *t = Getattr(n, "type");
 824  ParmList *l = Getattr(n, "parms");
 825  String *value = Getattr(n, "value");
 826
 827  String *proc_name = NewString("");
 828  String *wname = NewString("");
 829  String *mangle = NewString("");
 830  String *tm;
 831  String *tm2 = NewString("");
 832  String *source = NewString("");
 833  String *argnum = NewString("0");
 834  String *arg = NewString("argv[0]");
 835  Wrapper *f;
 836  String *overname = 0;
 837  String *scmname;
 838  String *rvalue;
 839  SwigType *nctype;
 840
 841  scmname = NewString(iname);
 842  Replaceall(scmname, "_", "-");
 843
 844  Printf(source, "swig_const_%s", iname);
 845  Replaceall(source, "::", "__");
 846
 847  Printf(mangle, "\"%s\"", SwigType_manglestr(t));
 848
 849  if (Getattr(n, "sym:overloaded")) {
 850    overname = Getattr(n, "sym:overname");
 851  } else {
 852    if (!addSymbol(iname, n))
 853      return SWIG_ERROR;
 854  }
 855
 856  Append(wname, Swig_name_wrapper(iname));
 857  if (overname) {
 858    Append(wname, overname);
 859  }
 860
 861  nctype = NewString(t);
 862  if (SwigType_isconst(nctype)) {
 863    Delete(SwigType_pop(nctype));
 864  }
 865
 866  bool is_enum_item = (Cmp(nodeType(n), "enumitem") == 0);
 867  if (SwigType_type(nctype) == T_STRING) {
 868    rvalue = NewStringf("\"%s\"", value);
 869  } else if (SwigType_type(nctype) == T_CHAR && !is_enum_item) {
 870    rvalue = NewStringf("\'%s\'", value);
 871  } else {
 872    rvalue = NewString(value);
 873  }
 874
 875  /* Special hook for member pointer */
 876  if (SwigType_type(t) == T_MPOINTER) {
 877    Printf(f_header, "static %s = %s;\n", SwigType_str(t, source), rvalue);
 878  } else {
 879    if ((tm = Swig_typemap_lookup("constcode", n, name, 0))) {
 880      Replaceall(tm, "$source", rvalue);
 881      Replaceall(tm, "$target", source);
 882      Replaceall(tm, "$result", source);
 883      Replaceall(tm, "$value", rvalue);
 884      Printf(f_header, "%s\n", tm);
 885    } else {
 886      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
 887      return SWIG_NOWRAP;
 888    }
 889  }
 890
 891  f = NewWrapper();
 892
 893  /* Attach the standard typemaps */
 894  emit_attach_parmmaps(l, f);
 895  Setattr(n, "wrap:parms", l);
 896
 897  // evaluation function names
 898
 899  // Check for interrupts
 900  Printv(f->code, "C_trace(\"", scmname, "\");\n", NIL);
 901
 902  if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
 903
 904    Setattr(n, "wrap:name", wname);
 905    Printv(f->def, "static ", "void ", wname, "(C_word, C_word, C_word) C_noret;\n", NIL);
 906
 907    Printv(f->def, "static ", "void ", wname, "(C_word argc, C_word closure, " "C_word continuation) {\n", NIL);
 908
 909    Wrapper_add_local(f, "resultobj", "C_word resultobj");
 910
 911    Printf(f->code, "if (argc!=2) C_bad_argc(argc,2);\n");
 912
 913    // Return the value of the variable
 914    if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
 915
 916      Replaceall(tm, "$source", source);
 917      Replaceall(tm, "$varname", source);
 918      Replaceall(tm, "$target", "resultobj");
 919      Replaceall(tm, "$result", "resultobj");
 920      /* Printf(f->code, "%s\n", tm); */
 921      emit_action_code(n, f->code, tm);
 922    } else {
 923      Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
 924    }
 925
 926    Printv(f->code, "{\n",
 927	   "C_word func;\n",
 928	   "SWIG_Chicken_FindCreateProxy(func, resultobj)\n",
 929	   "if (C_swig_is_closurep(func))\n",
 930	   "  ((C_proc4)(void *)C_block_item(func, 0))(4,func,continuation,resultobj,C_SCHEME_FALSE);\n",
 931	   "else\n", "  C_kontinue(continuation, resultobj);\n", "}\n", NIL);
 932
 933    /* Error handling code */
 934#ifdef USE_FAIL
 935    Printf(f->code, "fail:\n");
 936    Printf(f->code, "swig_panic (\"failure in " "'%s' SWIG wrapper\");\n", proc_name);
 937#endif
 938    Printf(f->code, "}\n");
 939
 940    Wrapper_print(f, f_wrappers);
 941
 942    /* Now register the variable with the interpreter.   */
 943    addMethod(scmname, wname);
 944
 945    if (!in_class || member_name) {
 946      String *clos_name;
 947      if (in_class)
 948	clos_name = NewString(member_name);
 949      else
 950	clos_name = chickenNameMapping(scmname, (char *) "");
 951      if (GetFlag(n, "feature:constasvar")) {
 952	Printv(clos_methods, "(define ", clos_name, " (", chickenPrimitiveName(scmname), "))\n", NIL);
 953	Printv(scm_const_defs, "(set! ", scmname, " (", scmname, "))\n", NIL);
 954      } else {
 955	Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
 956      }
 957      Delete(clos_name);
 958    }
 959
 960  } else {
 961    Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0));
 962  }
 963
 964  Delete(wname);
 965  Delete(nctype);
 966  Delete(proc_name);
 967  Delete(argnum);
 968  Delete(arg);
 969  Delete(tm2);
 970  Delete(mangle);
 971  Delete(source);
 972  Delete(rvalue);
 973  DelWrapper(f);
 974  return SWIG_OK;
 975}
 976
 977int CHICKEN::classHandler(Node *n) {
 978  /* Create new strings for building up a wrapper function */
 979  have_constructor = 0;
 980  constructor_dispatch = 0;
 981  constructor_name = 0;
 982
 983  c_class_name = NewString(Getattr(n, "sym:name"));
 984  class_name = NewString("");
 985  short_class_name = NewString("");
 986  Printv(class_name, "<", c_class_name, ">", NIL);
 987  Printv(short_class_name, c_class_name, NIL);
 988  Replaceall(class_name, "_", "-");
 989  Replaceall(short_class_name, "_", "-");
 990
 991  if (!addSymbol(class_name, n))
 992    return SWIG_ERROR;
 993
 994  /* Handle inheritance */
 995  String *base_class = NewString("");
 996  List *baselist = Getattr(n, "bases");
 997  if (baselist && Len(baselist)) {
 998    Iterator base = First(baselist);
 999    while (base.item) {
1000      if (!Getattr(base.item, "feature:ignore"))
1001	Printv(base_class, "<", Getattr(base.item, "sym:name"), "> ", NIL);
1002      base = Next(base);
1003    }
1004  }
1005
1006  Replaceall(base_class, "_", "-");
1007
1008  String *scmmod = NewString(module);
1009  Replaceall(scmmod, "_", "-");
1010
1011  Printv(clos_class_defines, "(define ", class_name, "\n", "  (make <swig-metaclass-", scmmod, "> 'name \"", short_class_name, "\"\n", NIL);
1012  Delete(scmmod);
1013
1014  if (Len(base_class)) {
1015    Printv(clos_class_defines, "    'direct-supers (list ", base_class, ")\n", NIL);
1016  } else {
1017    Printv(clos_class_defines, "    'direct-supers (list <object>)\n", NIL);
1018  }
1019
1020  Printf(clos_class_defines, "    'direct-slots (list 'swig-this\n");
1021
1022  String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));
1023
1024  SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
1025  swigtype_ptr = SwigType_manglestr(ct);
1026
1027  Printf(f_runtime, "static swig_chicken_clientdata _swig_chicken_clientdata%s = { 0 };\n", mangled_classname);
1028  Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr, ", (void *) &_swig_chicken_clientdata", mangled_classname, ");\n", NIL);
1029  SwigType_remember(ct);
1030
1031  /* Emit all of the members */
1032
1033  in_class = 1;
1034  Language::classHandler(n);
1035  in_class = 0;
1036
1037  Printf(clos_class_defines, ")))\n\n");
1038
1039  if (have_constructor) {
1040    Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", "  (swig-initialize obj initargs ", NIL);
1041    if (constructor_arg_types) {
1042      String *initfunc_name = NewStringf("%s@@SWIG@initmethod", class_name);
1043      String *func_call = buildClosFunctionCall(constructor_arg_types, initfunc_name, chickenPrimitiveName(constructor_name));
1044      Printf(clos_methods, "%s)\n)\n", initfunc_name);
1045      Printf(clos_methods, "(declare (hide %s))\n", initfunc_name);
1046      Printf(clos_methods, "%s\n", func_call);
1047      Delete(func_call);
1048      Delete(initfunc_name);
1049      Delete(constructor_arg_types);
1050      constructor_arg_types = 0;
1051    } else if (constructor_dispatch) {
1052      Printf(clos_methods, "%s)\n)\n", constructor_dispatch);
1053      Delete(constructor_dispatch);
1054      constructor_dispatch = 0;
1055    } else {
1056      Printf(clos_methods, "%s)\n)\n", chickenPrimitiveName(constructor_name));
1057    }
1058    Delete(constructor_name);
1059    constructor_name = 0;
1060  } else {
1061    Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n", "  (swig-initialize obj initargs (lambda x #f)))\n", NIL);
1062  }
1063
1064  /* export class initialization function */
1065  if (clos) {
1066    String *funcname = NewString(mangled_classname);
1067    Printf(funcname, "_swig_chicken_setclosclass");
1068    String *closfuncname = NewString(funcname);
1069    Replaceall(closfuncname, "_", "-");
1070
1071    Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n",
1072	   "static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n",
1073	   "  C_trace(\"", funcname, "\");\n",
1074	   "  if (argc!=3) C_bad_argc(argc,3);\n",
1075	   "  swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr, "->clientdata;\n",
1076	   "  cdata->gc_proxy_create = CHICKEN_new_gc_root();\n",
1077	   "  CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n", "  C_kontinue(continuation, C_SCHEME_UNDEFINED);\n", "}\n", NIL);
1078    addMethod(closfuncname, funcname);
1079
1080    Printv(clos_methods, "(", chickenPrimitiveName(closfuncname), " (lambda (x lst) (if lst ",
1081	   "(cons (make ", class_name, " 'swig-this x) lst) ", "(make ", class_name, " 'swig-this x))))\n\n", NIL);
1082    Delete(closfuncname);
1083    Delete(funcname);
1084  }
1085
1086  Delete(mangled_classname);
1087  Delete(swigtype_ptr);
1088  swigtype_ptr = 0;
1089
1090  Delete(class_name);
1091  Delete(short_class_name);
1092  Delete(c_class_name);
1093  class_name = 0;
1094  short_class_name = 0;
1095  c_class_name = 0;
1096
1097  return SWIG_OK;
1098}
1099
1100int CHICKEN::memberfunctionHandler(Node *n) {
1101  String *iname = Getattr(n, "sym:name");
1102  String *proc = NewString(iname);
1103  Replaceall(proc, "_", "-");
1104
1105  member_name = chickenNameMapping(proc, short_class_name);
1106  Language::memberfunctionHandler(n);
1107  Delete(member_name);
1108  member_name = NULL;
1109  Delete(proc);
1110
1111  return SWIG_OK;
1112}
1113
1114int CHICKEN::staticmemberfunctionHandler(Node *n) {
1115  String *iname = Getattr(n, "sym:name");
1116  String *proc = NewString(iname);
1117  Replaceall(proc, "_", "-");
1118
1119  member_name = NewStringf("%s-%s", short_class_name, proc);
1120  Language::staticmemberfunctionHandler(n);
1121  Delete(member_name);
1122  member_name = NULL;
1123  Delete(proc);
1124
1125  return SWIG_OK;
1126}
1127
1128int CHICKEN::membervariableHandler(Node *n) {
1129  String *iname = Getattr(n, "sym:name");
1130  //String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));
1131
1132  Language::membervariableHandler(n);
1133
1134  String *proc = NewString(iname);
1135  Replaceall(proc, "_", "-");
1136
1137  //Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
1138  Node *class_node = classLookup(Getattr(n, "type"));
1139
1140  //String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
1141  //String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);
1142  String *getfunc = Swig_name_get(NSPACE_TODO, Swig_name_member(NSPACE_TODO, c_class_name, iname));
1143  Replaceall(getfunc, "_", "-");
1144  String *setfunc = Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, c_class_name, iname));
1145  Replaceall(setfunc, "_", "-");
1146
1147  Printv(clos_class_defines, "        (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);
1148
1149  if (!GetFlag(n, "feature:immutable")) {
1150    if (class_node) {
1151      Printv(clos_class_defines, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
1152    } else {
1153      Printv(clos_class_defines, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
1154    }
1155  } else {
1156    Printf(clos_class_defines, ")\n");
1157  }
1158
1159  Delete(proc);
1160  Delete(setfunc);
1161  Delete(getfunc);
1162  return SWIG_OK;
1163}
1164
1165int CHICKEN::staticmembervariableHandler(Node *n) {
1166  String *iname = Getattr(n, "sym:name");
1167  String *proc = NewString(iname);
1168  Replaceall(proc, "_", "-");
1169
1170  member_name = NewStringf("%s-%s", short_class_name, proc);
1171  Language::staticmembervariableHandler(n);
1172  Delete(member_name);
1173  member_name = NULL;
1174  Delete(proc);
1175
1176  return SWIG_OK;
1177}
1178
1179int CHICKEN::constructorHandler(Node *n) {
1180  have_constructor = 1;
1181  has_constructor_args = 0;
1182
1183
1184  exporting_constructor = true;
1185  Language::constructorHandler(n);
1186  exporting_constructor = false;
1187
1188  has_constructor_args = 1;
1189
1190  String *iname = Getattr(n, "sym:name");
1191  constructor_name = Swig_name_construct(NSPACE_TODO, iname);
1192  Replaceall(constructor_name, "_", "-");
1193  return SWIG_OK;
1194}
1195
1196int CHICKEN::destructorHandler(Node *n) {
1197
1198  if (no_collection)
1199    member_name = NewStringf("delete-%s", short_class_name);
1200
1201  exporting_destructor = true;
1202  Language::destructorHandler(n);
1203  exporting_destructor = false;
1204
1205  if (no_collection) {
1206    Delete(member_name);
1207    member_name = NULL;
1208  }
1209
1210  return SWIG_OK;
1211}
1212
1213int CHICKEN::importDirective(Node *n) {
1214  String *modname = Getattr(n, "module");
1215  if (modname && clos_uses) {
1216
1217    // Find the module node for this imported module.  It should be the
1218    // first child but search just in case.
1219    Node *mod = firstChild(n);
1220    while (mod && Strcmp(nodeType(mod), "module") != 0)
1221      mod = nextSibling(mod);
1222
1223    if (mod) {
1224      String *name = Getattr(mod, "name");
1225      if (name) {
1226	Printf(closprefix, "(declare (uses %s))\n", name);
1227      }
1228    }
1229  }
1230
1231  return Language::importDirective(n);
1232}
1233
1234String *CHICKEN::buildClosFunctionCall(List *types, const_String_or_char_ptr closname, const_String_or_char_ptr funcname) {
1235  String *method_signature = NewString("");
1236  String *func_args = NewString("");
1237  String *func_call = NewString("");
1238
1239  Iterator arg_type;
1240  int arg_count = 0;
1241  int optional_arguments = 0;
1242
1243  for (arg_type = First(types); arg_type.item; arg_type = Next(arg_type)) {
1244    if (Strcmp(arg_type.item, "^^##optional$$") == 0) {
1245      optional_arguments = 1;
1246    } else {
1247      Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item);
1248      arg_type = Next(arg_type);
1249      if (!arg_type.item)
1250	break;
1251
1252      String *arg = NewStringf("arg%i", arg_count);
1253      String *access_arg = Copy(arg_type.item);
1254
1255      Replaceall(access_arg, "$input", arg);
1256      Printf(func_args, " %s", access_arg);
1257
1258      Delete(arg);
1259      Delete(access_arg);
1260    }
1261    arg_count++;
1262  }
1263
1264  if (optional_arguments) {
1265    Printf(func_call, "(define-method (%s %s . args) (apply %s %s args))", closname, method_signature, funcname, func_args);
1266  } else {
1267    Printf(func_call, "(define-method (%s %s) (%s %s))", closname, method_signature, funcname, func_args);
1268  }
1269
1270  Delete(method_signature);
1271  Delete(func_args);
1272
1273  return func_call;
1274}
1275
1276extern "C" {
1277
1278  /* compares based on non-primitive names */
1279  static int compareTypeListsHelper(const DOH *a, const DOH *b, int opt_equal) {
1280    List *la = (List *) a;
1281    List *lb = (List *) b;
1282
1283    Iterator ia = First(la);
1284    Iterator ib = First(lb);
1285
1286    while (ia.item && ib.item) {
1287      int ret = Strcmp(ia.item, ib.item);
1288      if (ret)
1289	return ret;
1290      ia = Next(Next(ia));
1291      ib = Next(Next(ib));
1292    } if (opt_equal && ia.item && Strcmp(ia.item, "^^##optional$$") == 0)
1293      return 0;
1294    if (ia.item)
1295      return -1;
1296    if (opt_equal && ib.item && Strcmp(ib.item, "^^##optional$$") == 0)
1297      return 0;
1298    if (ib.item)
1299      return 1;
1300
1301    return 0;
1302  }
1303
1304  static int compareTypeLists(const DOH *a, const DOH *b) {
1305    return compareTypeListsHelper(a, b, 0);
1306  }
1307}
1308
1309void CHICKEN::dispatchFunction(Node *n) {
1310  /* Last node in overloaded chain */
1311
1312  int maxargs;
1313  String *tmp = NewString("");
1314  String *dispatch = Swig_overload_dispatch(n, "%s (2+$numargs,closure," "continuation$commaargs);", &maxargs);
1315
1316  /* Generate a dispatch wrapper for all overloaded functions */
1317
1318  Wrapper *f = NewWrapper();
1319  String *iname = Getattr(n, "sym:name");
1320  String *wname = NewString("");
1321  String *scmname = NewString(iname);
1322  Replaceall(scmname, "_", "-");
1323
1324  Append(wname, Swig_name_wrapper(iname));
1325
1326  Printv(f->def, "static void real_", wname, "(C_word, C_word, C_word, C_word) C_noret;\n", NIL);
1327
1328  Printv(f->def, "static void real_", wname, "(C_word oldargc, C_word closure, C_word continuation, C_word args) {", NIL);
1329
1330  Wrapper_add_local(f, "argc", "int argc");
1331  Printf(tmp, "C_word argv[%d]", maxargs + 1);
1332  Wrapper_add_local(f, "argv", tmp);
1333  Wrapper_add_local(f, "ii", "int ii");
1334  Wrapper_add_local(f, "t", "C_word t = args");
1335  Printf(f->code, "if (!C_swig_is_list (args)) {\n");
1336  Printf(f->code, "  swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, " "\"Argument #1 must be a list of overloaded arguments\");\n");
1337  Printf(f->code, "}\n");
1338  Printf(f->code, "argc = C_unfix (C_i_length (args));\n");
1339  Printf(f->code, "for (ii = 0; (ii < argc) && (ii < %d); ii++, t = C_block_item (t, 1)) {\n", maxargs);
1340  Printf(f->code, "argv[ii] = C_block_item (t, 0);\n");
1341  Printf(f->code, "}\n");
1342
1343  Printv(f->code, dispatch, "\n", NIL);
1344  Printf(f->code, "swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE," "\"No matching function for overloaded '%s'\");\n", iname);
1345  Printv(f->code, "}\n", NIL);
1346  Wrapper_print(f, f_wrappers);
1347  addMethod(scmname, wname);
1348
1349  DelWrapper(f);
1350  f = NewWrapper();
1351
1352  /* varargs */
1353  Printv(f->def, "void ", wname, "(C_word, C_word, C_word, ...) C_noret;\n", NIL);
1354  Printv(f->def, "void ", wname, "(C_word c, C_word t0, C_word t1, ...) {", NIL);
1355  Printv(f->code,
1356	 "C_word t2;\n",
1357	 "va_list v;\n",
1358	 "C_word *a, c2 = c;\n",
1359	 "C_save_rest (t1, c2, 2);\n", "a = C_alloc((c-2)*3);\n", "t2 = C_restore_rest (a, C_rest_count (0));\n", "real_", wname, " (3, t0, t1, t2);\n", NIL);
1360  Printv(f->code, "}\n", NIL);
1361  Wrapper_print(f, f_wrappers);
1362
1363  /* Now deal with overloaded function when exporting clos */
1364  if (clos) {
1365    List *flist = Getattr(overload_parameter_lists, scmname);
1366    if (flist) {
1367      Delattr(overload_parameter_lists, scmname);
1368
1369      SortList(flist, compareTypeLists);
1370
1371      String *clos_name;
1372      if (have_constructor && !has_constructor_args) {
1373	has_constructor_args = 1;
1374	constructor_dispatch = NewStringf("%s@SWIG@new@dispatch", short_class_name);
1375	clos_name = Copy(constructor_dispatch);
1376	Printf(clos_methods, "(declare (hide %s))\n", clos_name);
1377      } else if (in_class)
1378	clos_name = NewString(member_name);
1379      else
1380	clos_name = chickenNameMapping(scmname, (char *) "");
1381
1382      Iterator f;
1383      List *prev = 0;
1384      int all_primitive = 1;
1385
1386      /* first check for duplicates and an empty call */
1387      String *newlist = NewList();
1388      for (f = First(flist); f.item; f = Next(f)) {
1389	/* check if cur is a duplicate of prev */
1390	if (prev && compareTypeListsHelper(f.item, prev, 1) == 0) {
1391	  Delete(f.item);
1392	} else {
1393	  Append(newlist, f.item);
1394	  prev = f.item;
1395	  Iterator j;
1396	  for (j = First(f.item); j.item; j = Next(j)) {
1397	    if (Strcmp(j.item, "^^##optional$$") != 0 && Strcmp(j.item, "<top>") != 0)
1398	      all_primitive = 0;
1399	  }
1400	}
1401      }
1402      Delete(flist);
1403      flist = newlist;
1404
1405      if (all_primitive) {
1406	Printf(clos_methods, "(define %s %s)\n", clos_name, chickenPrimitiveName(scmname));
1407      } else {
1408	for (f = First(flist); f.item; f = Next(f)) {
1409	  /* now export clos code for argument */
1410	  String *func_call = buildClosFunctionCall(f.item, clos_name, chickenPrimitiveName(scmname));
1411	  Printf(clos_methods, "%s\n", func_call);
1412	  Delete(f.item);
1413	  Delete(func_call);
1414	}
1415      }
1416
1417      Delete(clos_name);
1418      Delete(flist);
1419    }
1420  }
1421
1422  DelWrapper(f);
1423  Delete(dispatch);
1424  Delete(tmp);
1425  Delete(wname);
1426}
1427
1428int CHICKEN::isPointer(SwigType *t) {
1429  return SwigType_ispointer(SwigType_typedef_resolve_all(t));
1430}
1431
1432void CHICKEN::addMethod(String *scheme_name, String *function) {
1433  String *sym = NewString("");
1434  if (clos) {
1435    Append(sym, "primitive:");
1436  }
1437  Append(sym, scheme_name);
1438
1439  /* add symbol to Chicken internal symbol table */
1440  if (hide_primitive) {
1441    Printv(f_init, "{\n",
1442	   "  C_word *p0 = a;\n", "  *(a++)=C_CLOSURE_TYPE|1;\n", "  *(a++)=(C_word)", function, ";\n", "  C_mutate(return_vec++, (C_word)p0);\n", "}\n", NIL);
1443  } else {
1444    Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));
1445    Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n", Len(sym), sym);
1446    Printv(f_init, "C_mutate ((C_word*)sym+1, (*a=C_CLOSURE_TYPE|1, a[1]=(C_word)", function, ", tmp=(C_word)a, a+=2, tmp));\n", NIL);
1447  }
1448
1449  if (hide_primitive) {
1450    Setattr(primitive_names, scheme_name, NewStringf("(vector-ref swig-init-return %i)", num_methods));
1451  } else {
1452    Setattr(primitive_names, scheme_name, Copy(sym));
1453  }
1454
1455  num_methods++;
1456
1457  Delete(sym);
1458}
1459
1460String *CHICKEN::chickenPrimitiveName(String *name) {
1461  String *value = Getattr(primitive_names, name);
1462  if (value)
1463    return value;
1464  else {
1465    Swig_error(input_file, line_number, "Internal Error: attempting to reference non-existant primitive name %s\n", name);
1466    return NewString("#f");
1467  }
1468}
1469
1470int CHICKEN::validIdentifier(String *s) {
1471  char *c = Char(s);
1472  /* Check whether we have an R5RS identifier. */
1473  /* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
1474  /* <initial> --> <letter> | <special initial> */
1475  if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
1476	|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
1477	|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
1478	|| (*c == '^') || (*c == '_') || (*c == '~'))) {
1479    /* <peculiar identifier> --> + | - | ... */
1480    if ((strcmp(c, "+") == 0)
1481	|| strcmp(c, "-") == 0 || strcmp(c, "...") == 0)
1482      return 1;
1483    else
1484      return 0;
1485  }
1486  /* <subsequent> --> <initial> | <digit> | <special subsequent> */
1487  while (*c) {
1488    if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
1489	  || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
1490	  || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
1491	  || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
1492	  || (*c == '-') || (*c == '.') || (*c == '@')))
1493      return 0;
1494    c++;
1495  }
1496  return 1;
1497}
1498
1499  /* ------------------------------------------------------------
1500   * closNameMapping()
1501   * Maps the identifier from C++ to the CLOS based on command 
1502   * line parameters and such.
1503   * If class_name = "" that means the mapping is for a function or
1504   * variable not attached to any class.
1505   * ------------------------------------------------------------ */
1506String *CHICKEN::chickenNameMapping(String *name, const_String_or_char_ptr class_name) {
1507  String *n = NewString("");
1508
1509  if (Strcmp(class_name, "") == 0) {
1510    // not part of a class, so no class name to prefix
1511    if (clossymnameprefix) {
1512      Printf(n, "%s%s", clossymnameprefix, name);
1513    } else {
1514      Printf(n, "%s", name);
1515    }
1516  } else {
1517    if (useclassprefix) {
1518      Printf(n, "%s-%s", class_name, name);
1519    } else {
1520      if (clossymnameprefix) {
1521	Printf(n, "%s%s", clossymnameprefix, name);
1522      } else {
1523	Printf(n, "%s", name);
1524      }
1525    }
1526  }
1527  return n;
1528}
1529
1530String *CHICKEN::runtimeCode() {
1531  String *s = Swig_include_sys("chickenrun.swg");
1532  if (!s) {
1533    Printf(stderr, "*** Unable to open 'chickenrun.swg'\n");
1534    s = NewString("");
1535  }
1536  return s;
1537}
1538
1539String *CHICKEN::defaultExternalRuntimeFilename() {
1540  return NewString("swigchickenrun.h");
1541}