/********************************************************************
 * CHICKEN module for SWIG
 *
 * Author : Jonah Beckford
 * 
 * Major restructuring: John Lenz
 *
 * Modified from mzscheme.cxx, guile.cxx and python.cxx : David
 * Beazley
 *
 * Please read the file LICENSE for the copyright and terms by which
 * SWIG can be used and distributed.
 *
 ********************************************************************/

char cvsroot_chicken_cxx[] = "$Header: /cvsroot/swig/SWIG/Source/Modules/chicken.cxx,v 1.42 2005/04/16 21:42:42 wuzzeb Exp $";

/***********************************************************************
 * $Header: /cvsroot/swig/SWIG/Source/Modules/chicken.cxx,v 1.42 2005/04/16 21:42:42 wuzzeb Exp $
 *
 * chicken.cxx
 *
 * Definitions for adding functions to CHICKEN
 ***********************************************************************/

#include "swigmod.h"

#include <ctype.h>

static const char *chicken_usage = (char*)"\
\
CHICKEN Options (available with -chicken)\n\
     -proxy                 - Export TinyCLOS class definitions\n\
     -closprefix <prefix>   - Prepend <prefix> to all clos identifiers\n\
     -useclassprefix        - Prepend the class name to all clos identifiers\n\
     -unhideprimitive       - Unhide the primitive: symbols\n\
     -nounit                - Do not (declare (unit ...)) in scheme file\n\
     -noclosuses            - Do not (declare (uses ...)) in scheme file\n\
     -nocollection          - Do not register pointers with chicken garbage\n\
                              collector and export destructors\n\
\n"
;

static char          *module = 0;
static char          *chicken_path=(char*)"chicken";
static int           num_methods = 0;

static  File         *f_runtime = 0;
static  File         *f_header = 0;
static  File         *f_wrappers = 0;
static  File         *f_init = 0;
static  String       *chickentext = 0;
static  String       *closprefix = 0;
static String        *swigtype_ptr = 0;


static  String       *f_sym_size = 0;

/* some options */
static int           declare_unit = 1;
static int           no_collection = 0;
static int           clos_uses = 1;

/* C++ Support + Clos Classes */
static int           clos = 0;
static  String       *class_name  = 0;
static  String       *short_class_name  = 0;

static  int          in_class = 0;
static  int          have_constructor = 0;
static  bool         exporting_destructor = false;
static  bool         exporting_constructor = false;
static  String       *constructor_name = 0;
static String        *member_name = 0;

/* sections of the clos code */
static  String       *clos_class_defines = 0;
static  String       *clos_methods = 0;

/* Some clos options */
static int           useclassprefix = 0;
static String        *clossymnameprefix = 0;
static  int          hide_primitive = 1;
static Hash          *primitive_names = 0;

/* Used for overloading constructors */
static int           has_constructor_args = 0;
static List          *constructor_arg_types = 0;
static String        *constructor_dispatch = 0;

static Hash          *overload_parameter_lists = 0;

class CHICKEN : public Language {
public:

  virtual void main(int argc, char *argv[]);
  virtual int  top(Node *n);
  virtual int  functionWrapper(Node *n); 
  virtual int  variableWrapper(Node *n);
  virtual int  constantWrapper(Node *n);
  virtual int  classHandler(Node *n);
  virtual int  memberfunctionHandler(Node *n);
  virtual int  membervariableHandler(Node *n);
  virtual int  constructorHandler(Node *n);
  virtual int  destructorHandler(Node *n);
  virtual int  validIdentifier(String *s);
  virtual int  staticmembervariableHandler(Node *n);
  virtual int  staticmemberfunctionHandler(Node *n);
  virtual int  importDirective(Node *n);

protected:
  void    addMethod(String *scheme_name, String *function);
  /* Return true iff T is a pointer type */
  int     isPointer(SwigType *t);
  void    dispatchFunction(Node *n);

  String *chickenNameMapping(String *, String_or_char *);
  String *chickenPrimitiveName(String *);

  String *runtimeCode();
  String *defaultExternalRuntimeFilename();
  String *buildClosFunctionCall(List *types, String_or_char *closname, String_or_char *funcname);
};

/* -----------------------------------------------------------------------
 * swig_chicken()    - Instantiate module
 * ----------------------------------------------------------------------- */

static Language * new_swig_chicken() {
  return new CHICKEN();
}

extern "C"  {
  Language * swig_chicken(void) {
    return new_swig_chicken();
  }
}

void 
CHICKEN::main(int argc, char *argv[])
{
  int i;
    
  SWIG_library_directory(chicken_path);
    
  // Look for certain command line options
  for (i = 1; i < argc; i++) {
    if (argv[i]) {
      if (strcmp(argv[i], "-help") == 0) {
        fputs(chicken_usage, stdout);
        SWIG_exit(0);
      } 
      else if (strcmp(argv[i],"-proxy") == 0) {
        clos = 1;
        Swig_mark_arg(i);
      } else if (strcmp(argv[i],"-closprefix") == 0) {
          if (argv[i+1]) {
              clossymnameprefix = NewString(argv[i+1]);
              Swig_mark_arg(i);
              Swig_mark_arg(i+1);
              i++;
          } else {
              Swig_arg_error();
          }
      } else if (strcmp(argv[i],"-useclassprefix") == 0) {
          useclassprefix = 1;
          Swig_mark_arg(i);
      } else if (strcmp(argv[i],"-unhideprimitive") == 0) {
          hide_primitive = 0;
          Swig_mark_arg(i);
      } else if (strcmp(argv[i],"-nounit") == 0) {
          declare_unit = 0;
          Swig_mark_arg(i);
      } else if (strcmp(argv[i],"-noclosuses") == 0) {
          clos_uses = 0;
          Swig_mark_arg(i);
      } else if (strcmp(argv[i],"-nocollection") == 0) {
          no_collection = 1;
          Swig_mark_arg(i);
      }
    }
  }

  if (!clos) hide_primitive = 0;

  // Add a symbol for this module
  Preprocessor_define("SWIGCHICKEN 1",0);
    
  // Set name of typemaps
    
  SWIG_typemap_lang("chicken");

  // Read in default typemaps */
  SWIG_config_file("chicken.swg");
  allow_overloading();
}
  
int
CHICKEN::top(Node *n)
{
  String *chicken_filename = NewString("");
  File *f_scm;
  String *scmmodule;
  
  /* Initialize all of the output files */
  String *outfile = Getattr(n,"outfile");
    
  f_runtime = NewFile(outfile,"w");
  if (!f_runtime) {
    Printf(stderr,"*** Can't open '%s'\n", outfile);
    SWIG_exit(EXIT_FAILURE);
  }
  f_init = NewString("");
  f_header = NewString("");
  f_wrappers = NewString("");
  chickentext = NewString("");
  closprefix = NewString("");
  f_sym_size = NewString("");
  primitive_names = NewHash();
  overload_parameter_lists = NewHash();
    
  /* Register file targets with the SWIG file handler */
  Swig_register_filebyname("header",f_header);
  Swig_register_filebyname("wrapper",f_wrappers);
  Swig_register_filebyname("runtime",f_runtime);
  Swig_register_filebyname("init",f_init);

  Swig_register_filebyname("chicken", chickentext);
  Swig_register_filebyname("closprefix", closprefix);
    
  clos_class_defines = NewString("");
  clos_methods = NewString("");

  Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
  Swig_banner(f_runtime);

  Printf(f_runtime, "/* Implementation : CHICKEN */\n\n");

  if (no_collection)
    Printf(f_runtime, "#define SWIG_CHICKEN_NO_COLLECTION 1\n");
    
  /* Set module name */
  module = Swig_copy_string(Char(Getattr(n, "name")));
  scmmodule = NewString(module);
  Replaceall(scmmodule, "_", "-");
 
  Printf(f_header,"#define SWIG_init swig_%s_init\n", module);
  Printf(f_header,"#define SWIG_name \"%s\"\n", scmmodule);

  Printf(f_wrappers,"#ifdef __cplusplus\n");
  Printf(f_wrappers,"extern \"C\" {\n");
  Printf(f_wrappers,"#endif\n\n");

  Language::top(n);

  SwigType_emit_type_table(f_runtime, f_wrappers);

  Printf(f_wrappers,"#ifdef __cplusplus\n");
  Printf(f_wrappers,"}\n");
  Printf(f_wrappers,"#endif\n");

  Printf(f_init, "C_kontinue (continuation, ret);\n");
  Printf(f_init, "}\n\n");

  Printf(f_init,"#ifdef __cplusplus\n");
  Printf(f_init,"}\n");
  Printf(f_init,"#endif\n");

  Printf(chicken_filename,"%s%s.scm", SWIG_output_directory(), module);
  if ((f_scm = NewFile(chicken_filename,"w")) == 0) {
    Printf(stderr,"Unable to open %s\n", chicken_filename);
    SWIG_exit(EXIT_FAILURE);
  }

  Printv(f_scm,
         ";; -*- buffer-read-only: t -*- vi: set ro:\n",
         ";; This file was created automatically by SWIG.\n",
         ";; Don't modify this file, modify the SWIG interface instead.\n",
         NIL);
  if (declare_unit)
    Printv(f_scm,"(declare (unit ", scmmodule, "))\n\n", NIL);
  Printv(f_scm,"(declare \n",
         tab4, "(hide swig-init swig-init-return)\n",
         tab4, "(foreign-declare \"C_extern void swig_", module, "_init(C_word,C_word,C_word) C_noret;\"))\n", NIL);
  Printv(f_scm,"(define swig-init (##core#primitive \"swig_", module,
         "_init\"))\n", NIL);
  Printv(f_scm,"(define swig-init-return (swig-init))\n\n", NIL);

  if (clos) {
    Printf (f_scm, "(declare (uses tinyclos))\n");
    Replaceall(closprefix,"$module", scmmodule);
    Printf (f_scm, "%s\n", closprefix);
    Printf (f_scm, "%s\n", clos_class_defines);
    Printf (f_scm, "%s\n", clos_methods);
  }

  Printf(f_scm, "%s\n", chickentext);


  Close(f_scm);
  Delete(f_scm);

  char buftmp[20];
  sprintf(buftmp, "%d", num_methods);
  Replaceall(f_init, "$nummethods", buftmp);
  Replaceall(f_init, "$symsize", f_sym_size);

  if (hide_primitive)
    Replaceall(f_init, "$veclength", buftmp);
  else
    Replaceall(f_init, "$veclength", "0");

  Delete(chicken_filename);
  Delete(chickentext);
  Delete(closprefix);
  Delete(overload_parameter_lists);

  Delete(clos_class_defines);
  Delete(clos_methods);

  /* Close all of the files */
  Delete(primitive_names);
  Delete(scmmodule);
  Dump(f_header,f_runtime);
  Dump(f_wrappers,f_runtime);
  Wrapper_pretty_print(f_init,f_runtime);
  Delete(f_header);
  Delete(f_wrappers);
  Delete(f_sym_size);
  Delete(f_init);
  Close(f_runtime);
  Delete(f_runtime);
  return SWIG_OK;
}

int
CHICKEN::functionWrapper(Node *n)
{
  
  String  *name  = Getattr(n,"name");
  String  *iname = Getattr(n,"sym:name");
  SwigType *d    = Getattr(n,"type");
  ParmList *l    = Getattr(n,"parms");

  Parm    *p;
  int     i;
  String *wname;
  String *source;
  Wrapper *f;
  String *mangle = NewString("");
  String *get_pointers;
  String *cleanup;
  String *argout;
  String *tm;
  String *overname = 0;
  String *declfunc = 0;
  String *scmname;
  bool any_specialized_arg = false;
  List *function_arg_types = NewList();
  int return_proxy_fastcall = 0;

  int     num_required;
  int     num_arguments;

  Printf(mangle, "\"%s\"", SwigType_manglestr(d));

  if (Getattr(n,"sym:overloaded")) {
    overname = Getattr(n,"sym:overname");
  } else {
    if (!addSymbol(iname,n)) return SWIG_ERROR;
  }

  f = NewWrapper();
  wname        = NewString("");
  get_pointers = NewString("");
  cleanup      = NewString("");
  argout       = NewString("");
  declfunc     = NewString("");
  scmname      = NewString(iname);
  Replaceall(scmname, "_", "-");

  /* Local vars */
  Wrapper_add_local(f,"resultobj", "C_word resultobj");

  /* Write code to extract function parameters. */
  emit_args(d, l, f);

  /* Attach the standard typemaps */
  emit_attach_parmmaps(l,f);
  Setattr(n,"wrap:parms",l);

  /* Get number of required and total arguments */
  num_arguments = emit_num_arguments(l);
  num_required  = emit_num_required(l);

  Append(wname, Swig_name_wrapper(iname));
  if (overname) {
    Append(wname, overname);
  }

  // Check for interrupts
  Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);

  Printv(f->def,
         "static ",
         "void ", wname,
         " (C_word argc, C_word closure, C_word continuation",
         NIL);
  Printv(declfunc,
         "void ", wname,
         "(C_word,C_word,C_word",
         NIL);

  /* Generate code for argument marshalling */
  for (i = 0, p=l; i < num_arguments; i++) {
    
    while (checkAttribute(p,"tmap:in:numinputs","0")) {
      p = Getattr(p,"tmap:in:next");
    }

    SwigType *pt = Getattr(p,"type");
    String   *ln = Getattr(p,"lname");

    source = NewStringf("scm%d",i+1);

    Printf(f->def, ", C_word scm%d", i+1);
    Printf(declfunc,",C_word");

    /* Look for an input typemap */
    if ((tm = Getattr(p,"tmap:in"))) {
      String *parse = Getattr(p,"tmap:in:parse");
      if (!parse) {
        Replaceall(tm,"$source",source);
        Replaceall(tm,"$target",ln);
        Replaceall(tm,"$input", source);
        Setattr(p,"emit:input", source);   /* Save the location of
                                              the object */
          
        if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) {
          Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
        } else {
          Replaceall(tm,"$disown","0");
        }

        if (i >= num_required)
          Printf(get_pointers, "if (argc-2>%i && (%s)) {\n", i, source);
        Printv(get_pointers,tm,"\n", NIL);
        if (i >= num_required)
          Printv(get_pointers, "}\n", NIL);

          if (clos) {
              if (i < num_required) {
                  if (strcmp("void", Char(pt)) != 0) {
                      Node *class_node = 0;
                      String *clos_code = Getattr(p, "tmap:in:closcode");
                      class_node = classLookup(pt);
                      if (clos_code && class_node) {
                          String *class_name = NewStringf("<%s>", Getattr(class_node, "sym:name"));
                          Append(function_arg_types, class_name);
                          Append(function_arg_types, Copy(clos_code));
                          any_specialized_arg = true;
                          Delete(class_name);
                      } else {
                          Append(function_arg_types, "<top>");
                          Append(function_arg_types, "$input");
                      }
                  }
              }
          }
          
      } else {
      }

      
      p = Getattr(p,"tmap:in:next");
      continue;
    } else {
      Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, 
                   "Unable to use type %s as a function argument.\n",
                   SwigType_str(pt,0));
      break;
    }

    Delete(source);
    p = nextSibling(p);
  }

  /* finish argument marshalling */

  Printf(f->def,  ") {");
  Printf(declfunc, ")");

  if (num_required != num_arguments) {
    Append(function_arg_types, "^^##optional$$");
  }

  /* First check the number of arguments is correct */
  if (num_arguments != num_required)
    Printf(f->code, "if (argc-2<%i || argc-2>%i) C_bad_argc(argc,%i);\n", num_required, num_arguments, num_required+2);
  else
    Printf(f->code, "if (argc!=%i) C_bad_argc(argc,%i);\n", num_arguments+2, num_arguments+2);

  /* Now piece together the first part of the wrapper function */
  Printv(f->code, get_pointers, NIL);

  /* Insert constraint checking code */
  for (p = l; p;) {
    if ((tm = Getattr(p,"tmap:check"))) {
      Replaceall(tm,"$target",Getattr(p,"lname"));
      Printv(f->code,tm,"\n",NIL);
      p = Getattr(p,"tmap:check:next");
    } else {
      p = nextSibling(p);
    }
  }
  
  /* Insert cleanup code */
  for (p = l; p;) {
    if ((tm = Getattr(p,"tmap:freearg"))) {
      Replaceall(tm,"$source",Getattr(p,"lname"));
      Printv(cleanup,tm,"\n",NIL);
      p = Getattr(p,"tmap:freearg:next");
    } else {
      p = nextSibling(p);
    }
  }

  /* Emit the function call */
  emit_action(n,f);

  /* Insert argument output code */
  for (p = l; p;) {
    if ((tm = Getattr(p,"tmap:argout"))) {
      if (!Wrapper_check_local(f, "gswig_list_p")) {
        Wrapper_add_local(f,"resultobjlast", "C_word resultobjlast");
        Wrapper_add_local(f,"gswig_list_p", "int gswig_list_p = 0");
      }
      Replaceall(tm,"$source",Getattr(p,"lname"));
      Replaceall(tm,"$target","resultobj");
      Replaceall(tm,"$arg",Getattr(p,"emit:input"));
      Replaceall(tm,"$input",Getattr(p,"emit:input"));
      Printf(argout, "%s", tm);
      p = Getattr(p,"tmap:argout:next");
    } else {
      p = nextSibling(p);
    }
  }

  /* Return the function value */
  if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
    Replaceall(tm,"$source", "result");
    Replaceall(tm,"$target", "resultobj");
    Replaceall(tm,"$result", "resultobj");
    if (Getattr(n,"feature:new")) {
      Replaceall(tm,"$owner","1");
    } else {
      Replaceall(tm,"$owner","0");
    }

    /* check for chickenfastproxy flag */
    if (Getattr(n, "tmap:out:chickenfastproxy")) {
      if (exporting_constructor && clos && hide_primitive) {
        /* Don't return a proxy, the wrapped CLOS class is the proxy */
        Replaceall(tm, "$proxy", "0");
      } else {
        /* can only do fast proxy if there are no argout paramaters... */
        if (Wrapper_check_local(f, "gswig_list_p")) {
          Replaceall(tm, "$proxy", "1");
        } else {
          Replaceall(tm, "$proxy", "0");
          return_proxy_fastcall = 1;
        }
      }
    }
    Printf(f->code, "%s", tm);
  } else {
    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);
  }

  /* Insert the argumetn output code */
  Printv(f->code, argout, NIL);

  /* Output cleanup code */
  Printv(f->code,cleanup,NIL);

  /* Look to see if there is any newfree cleanup code */
  if (Getattr(n,"feature:new")) {
    if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
      Replaceall(tm,"$source","result");
      Printf(f->code,"%s\n",tm);
    }
  }

  /* See if there is any return cleanup code */
  if ((tm = Swig_typemap_lookup_new("ret", n, "result", 0))) {
    Replaceall(tm,"$source","result");
    Printf(f->code,"%s\n",tm);
  }

  if (return_proxy_fastcall) {
    Printv(f->code,"{\n",
                   "C_word func;\n",
                   "SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
                   "if (C_swig_is_closurep(func))\n",
                   "  ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
                   "else\n",
                   "  C_kontinue(continuation, resultobj);\n",
                   "}\n", NIL);
  } else if (Wrapper_check_local(f, "gswig_list_p")) {
    Printv(f->code,"if (gswig_list_p)\n",
		   "  C_apply_values(3, C_SCHEME_UNDEFINED, continuation, resultobj);\n",
		   "else\n",
		   "  C_kontinue(continuation, resultobj);\n", NIL);
  } else {
    Printf(f->code,"C_kontinue (continuation, resultobj);\n");
  }

  /* Error handling code */
#ifdef USE_FAIL
  Printf(f->code,"fail:\n");
  Printv(f->code,cleanup,NIL);
  Printf(f->code,"swig_panic (\"failure in "
         "'$symname' SWIG function wrapper\");\n");
#endif
  Printf(f->code,"}\n");

  /* Substitute the cleanup code */
  Replaceall(f->code,"$cleanup",cleanup);

  /* Substitute the function name */
  Replaceall(f->code,"$symname",iname);
  Replaceall(f->code,"$result","resultobj");

  /* Dump the function out */
  Printv(f_wrappers, 
          "static ",
          declfunc, " C_noret;\n", NIL);
  Wrapper_print(f,f_wrappers);

  Setattr(n,"wrap:name", wname);

  /* Now register the function with the interpreter.   */
  if (!Getattr(n,"sym:overloaded")) {
    if (exporting_destructor && !no_collection) {
      Printf(f_init,
        "((swig_chicken_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (swig_chicken_destructor) %s;\n",
        swigtype_ptr, wname);
    } else {
      addMethod(scmname, wname);
    }

    /* Only export if we are not in a class, or if in a class memberfunction */
    if (!in_class || member_name) {
        String *method_def;
        String *clos_name;
        if (in_class)
            clos_name = NewString(member_name);
        else
            clos_name = chickenNameMapping(scmname, (char *)"");

        if (!any_specialized_arg) {
            method_def = NewString("");
            Printv(method_def, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")", NIL);
        } else { 
          method_def = buildClosFunctionCall(function_arg_types, clos_name, chickenPrimitiveName(scmname));
        }
        Printv(clos_methods, method_def, "\n", NIL);
        Delete(clos_name);
        Delete(method_def);
    }

    if (have_constructor && !has_constructor_args && any_specialized_arg) {
      has_constructor_args = 1;
      constructor_arg_types = Copy(function_arg_types);
    }
  } else {
    /* add function_arg_types to overload hash */
    List *flist = Getattr(overload_parameter_lists, scmname);
    if (!flist) {
      flist = NewList();
      Setattr(overload_parameter_lists, scmname, flist);
    }

    Append(flist, Copy(function_arg_types));

    if (!Getattr(n,"sym:nextSibling")) {
      dispatchFunction(n);
    }
  }


  Delete(wname);
  Delete(get_pointers);
  Delete(cleanup);
  Delete(declfunc);
  Delete(mangle);
  Delete(function_arg_types);
  DelWrapper(f);
  return SWIG_OK;
}

int
CHICKEN::variableWrapper(Node *n)  {
  char *name  = GetChar(n,"name");
  char *iname = GetChar(n,"sym:name");
  SwigType *t = Getattr(n,"type");
  ParmList *l    = Getattr(n,"parms");

  char  var_name[256];
  String *wname = NewString("");
  String *mangle = NewString("");
  String *tm;
  String *tm2 = NewString("");;
  String *argnum = NewString("0");
  String *arg = NewString("argv[0]");
  Wrapper *f;    
  String *overname = 0;
  String *scmname;

  int     num_required;
  int     num_arguments;

  scmname      = NewString(iname);
  Replaceall(scmname, "_", "-");

  Printf(mangle, "\"%s\"", SwigType_manglestr(t));

  if (Getattr(n,"sym:overloaded")) {
    overname = Getattr(n,"sym:overname");
  } else {
    if (!addSymbol(iname,n)) return SWIG_ERROR;
  }

  f = NewWrapper();
    
  /* Attach the standard typemaps */
  emit_attach_parmmaps(l,f);
  Setattr(n,"wrap:parms",l);

  /* Get number of required and total arguments */
  num_arguments = emit_num_arguments(l);
  num_required  = emit_num_required(l);

  // evaluation function names
  Append(wname, Swig_name_wrapper(iname));
  if (overname) {
    Append(wname, overname);
  }

  strcpy(var_name, Char(Swig_name_wrapper(iname)));
    
  // Check for interrupts
  Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);

  if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
      
    Printv(f->def, 
            "static ",
            "void ",wname,"(C_word, C_word, C_word, C_word) C_noret;\n", 
            NIL);
    Printv(f->def, 
            "static "
            "void ",wname,"(C_word argc, C_word closure, "
            "C_word continuation, C_word value) {\n", 
            NIL);
      
    Wrapper_add_local(f, "resultobj", "C_word resultobj");

    Printf(f->code, "if (argc!=2 && argc!=3) C_bad_argc(argc,2);\n");

    /* Check for a setting of the variable value */
    if (!Getattr(n,"feature:immutable")) {
      Printf(f->code, "if (argc > 2) {\n");
      if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
        Replaceall(tm,"$source","value");
        Replaceall(tm,"$target",name);
        Replaceall(tm,"$input","value");
        Printv(f->code, tm, "\n",NIL);
      }
      else {
        Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, 
                     "Unable to set variable of type %s.\n", 
                     SwigType_str(t,0));
      }
      Printf(f->code, "}\n");
    }

    String *varname;
    if (SwigType_istemplate((char*)name)) {
      varname = SwigType_namestr((char *)name);
    } else {
      varname = name;
    }
      
    // Now return the value of the variable - regardless
    // of evaluating or setting.
    if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
      Replaceall(tm,"$source",varname);
      Replaceall(tm,"$varname",varname);
      Replaceall(tm,"$target","resultobj");
      Replaceall(tm,"$result","resultobj");
      Printf(f->code, "%s\n", tm);
    }
    else {
      Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number,
                   "Unable to read variable of type %s\n", SwigType_str(t,0));
    }

    if (Getattr(n, "tmap:varout:chickenfastproxy")) {
      Printv(f->code,"{\n",
                     "C_word func;\n",
                     "SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
                     "if (C_swig_is_closurep(func))\n",
                     "  ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
                     "else\n",
                     "  C_kontinue(continuation, resultobj);\n",
                     "}\n", NIL);
    } else {
      Printf(f->code,"    C_kontinue (continuation, resultobj);\n");
    }

    /* Error handling code */
#ifdef USE_FAIL
    Printf(f->code,"fail:\n");
    Printf(f->code,"swig_panic (\"failure in "
           "'%s' SWIG wrapper\");\n", proc_name);
#endif
    Printf(f->code,"}\n");

    Wrapper_print(f, f_wrappers);
      
    /* Now register the variable with the interpreter.   */
    addMethod(scmname, wname);

    if (!in_class || member_name) {
        String *clos_name;
        if (in_class)
                clos_name = NewString(member_name);
        else
                clos_name = chickenNameMapping(scmname, (char *)"");

        Node *class_node = classLookup(t);
        if (class_node && Getattr(n, "tmap:varout:chickenfastproxy")) {
          Printv(clos_methods, "(define (", clos_name, " . lst) (if (null? lst) (", chickenPrimitiveName(scmname), ") (",
                     chickenPrimitiveName(scmname), " (slot-ref (car lst) 'swig-this))))\n", NIL);
        } else {
          /* Simply re-export the procedure */
          Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
        }
        Delete(clos_name);
    }
  } else {
    Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
                 "Unsupported variable type %s (ignored).\n", 
                 SwigType_str(t,0));
  }

  Delete(wname);
  Delete(argnum);
  Delete(arg);
  Delete(tm2);
  Delete(mangle);
  DelWrapper(f);
  return SWIG_OK;
}

/* ------------------------------------------------------------
 * constantWrapper()
 * ------------------------------------------------------------ */

int
CHICKEN::constantWrapper(Node *n)
{

  char *name  = GetChar(n,"name");
  char *iname = GetChar(n,"sym:name");
  SwigType *t = Getattr(n,"type");
  ParmList *l    = Getattr(n,"parms");
  String   *value = Getattr(n,"value");

  String *proc_name = NewString("");
  char  var_name[256];
  String *wname = NewString("");
  String *mangle = NewString("");
  String *tm;
  String *tm2 = NewString("");
  String *source = NewString("");
  String *argnum = NewString("0");
  String *arg = NewString("argv[0]");
  Wrapper *f;    
  String *overname = 0;
  String *scmname;
  String *rvalue;
  SwigType *nctype;

  int     num_required;
  int     num_arguments;

  scmname      = NewString(iname);
  Replaceall(scmname, "_", "-");

  Printf(source, "swig_const_%s", iname);
  Replaceall(source, "::", "__");

  Printf(mangle, "\"%s\"", SwigType_manglestr(t));

  if (Getattr(n,"sym:overloaded")) {
    overname = Getattr(n,"sym:overname");
  } else {
    if (!addSymbol(iname,n)) return SWIG_ERROR;
  }

  Append(wname, Swig_name_wrapper(iname));
  if (overname) {
    Append(wname, overname);
  }

  nctype = NewString(t);
  if (SwigType_isconst(nctype)) {
    Delete(SwigType_pop(nctype));
  }

  if (SwigType_type(nctype) == T_STRING) {
    rvalue = NewStringf("\"%s\"", value);
  } else if (SwigType_type(nctype) == T_CHAR) {
    rvalue = NewStringf("\'%s\'", value);
  } else {
    rvalue = NewString(value);
  }

  /* Special hook for member pointer */
  if (SwigType_type(t) == T_MPOINTER) {
    Printf(f_header, "static %s = %s;\n", SwigType_str(t,wname), rvalue);
    value = wname;
  }
  if ((tm = Swig_typemap_lookup_new("constcode", n, name, 0))) {
    Replaceall(tm,"$source",rvalue);
    Replaceall(tm,"$target",source);
    Replaceall(tm,"$result",source);
    Replaceall(tm,"$value",rvalue);
    Printf(f_header, "%s\n", tm);
  } 
  else {
    Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
                 "Unsupported constant value.\n");
    return SWIG_NOWRAP;
  }

  f = NewWrapper();
    
  /* Attach the standard typemaps */
  emit_attach_parmmaps(l,f);
  Setattr(n,"wrap:parms",l);

  /* Get number of required and total arguments */
  num_arguments = emit_num_arguments(l);
  num_required  = emit_num_required(l);

  // evaluation function names
    
  strcpy(var_name, Char(Swig_name_wrapper(iname)));
    
  // Check for interrupts
  Printv (f->code, "C_trace(\"",scmname,"\");\n", NIL);

  if (1 || (SwigType_type(t) != T_USER) || (isPointer(t))) {
      
    Printv(f->def, 
            "static ",
            "void ",wname,"(C_word, C_word, C_word) C_noret;\n", 
           NIL);

    Printv(f->def, 
            "static ",
            "void ",wname,"(C_word argc, C_word closure, "
            "C_word continuation) {\n", 
           NIL);
      
    Wrapper_add_local(f, "resultobj", "C_word resultobj");

    Printf(f->code, "if (argc!=2) C_bad_argc(argc,2);\n");

    // Return the value of the variable
    if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {

      Replaceall(tm,"$source",source);
      Replaceall(tm,"$varname",source);
      Replaceall(tm,"$target","resultobj");
      Replaceall(tm,"$result","resultobj");
      Printf(f->code, "%s\n", tm);
    }
    else {
      Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number,
                   "Unable to read variable of type %s\n", SwigType_str(t,0));
    }

    if (Getattr(n, "tmap:varout:chickenfastproxy")) {
      Printv(f->code,"{\n",
                     "C_word func;\n",
                     "SWIG_Chicken_FindCreateProxy(func, resultobj);\n",
                     "if (C_swig_is_closurep(func))\n",
                     "  ((C_proc3)(void *)C_block_item(func, 0))(3,func,continuation,resultobj);\n",
                     "else\n",
                     "  C_kontinue(continuation, resultobj);\n",
                     "}\n", NIL);
    } else {
      Printf(f->code,"    C_kontinue (continuation, resultobj);\n");
    }

    /* Error handling code */
#ifdef USE_FAIL
    Printf(f->code,"fail:\n");
    Printf(f->code,"swig_panic (\"failure in "
           "'%s' SWIG wrapper\");\n", proc_name);
#endif
    Printf(f->code,"}\n");

    Wrapper_print(f, f_wrappers);
      
    /* Now register the variable with the interpreter.   */
    addMethod(scmname, wname);

    if (!in_class || member_name) {
      String *clos_name;
      if (in_class)
        clos_name = NewString(member_name);
      else
        clos_name = chickenNameMapping(scmname, (char *)"");
      Printv(clos_methods, "(define ", clos_name, " ", chickenPrimitiveName(scmname), ")\n", NIL);
      Delete(clos_name);
    }

  } else {
    Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
                 "Unsupported variable type %s (ignored).\n", 
                 SwigType_str(t,0));
  }

  Delete(wname);
  Delete(nctype);
  Delete(proc_name);
  Delete(argnum);
  Delete(arg);
  Delete(tm2);
  Delete(mangle);
  Delete(source);
  Delete(rvalue);
  DelWrapper(f);
  return SWIG_OK;
}

int
CHICKEN::classHandler(Node *n)
{
  /* Create new strings for building up a wrapper function */
  have_constructor = 0;
  constructor_dispatch = 0;
  constructor_name = 0;
      
  class_name = NewString("");
  short_class_name = NewString("");
  Printv(class_name, "<", Getattr(n,"sym:name"), ">", NIL);
  Printv(short_class_name, Getattr(n,"sym:name"), NIL);
  Replaceall(class_name, "_", "-");
  Replaceall(short_class_name, "_", "-");
      
  if (!addSymbol(class_name,n)) return SWIG_ERROR;

  /* Handle inheritance */
  String *base_class = NewString("<");
  List *baselist = Getattr(n,"bases");
  if (baselist && Len(baselist)) {
    Iterator base = First(baselist);
    while (base.item) {
        Printv(base_class, Getattr(base.item, "sym:name"),NIL);
        base = Next(base);
        if (base.item) {
          Printf(base_class, "> <");
        }
      }
    }
    Printf(base_class, ">");
    Replaceall(base_class, "_", "-");

    String *scmmod = NewString(module);
    Replaceall(scmmod, "_", "-");

    Printv(clos_class_defines,"(define ", class_name, "\n",
                    "  (make <swig-metaclass-", scmmod, "> 'name \"", short_class_name, "\"\n", NIL);
    Delete(scmmod);

    if (Len(base_class) > 2) {
      Printv(clos_class_defines,"    'direct-supers (list ", base_class, ")\n", NIL);
    } else {
      Printv(clos_class_defines,"    'direct-supers (list <object>)\n", NIL);
    }

    Printf(clos_class_defines, "    'direct-slots (list 'swig-this\n");

    String *mangled_classname = Swig_name_mangle(Getattr(n, "sym:name"));

    SwigType *ct = NewStringf("p.%s", Getattr(n, "name"));
    swigtype_ptr = SwigType_manglestr(ct);

    Printf(f_runtime, "static swig_chicken_clientdata _swig_chicken_clientdata%s = { 0 };\n",
            mangled_classname);
    Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", swigtype_ptr,", (void *) &_swig_chicken_clientdata", mangled_classname, ");\n", NIL);
    SwigType_remember(ct);

  /* Emit all of the members */

  in_class = 1;
  Language::classHandler(n);
  in_class = 0;

  Printf(clos_class_defines, ")))\n\n");

  if (have_constructor) {
      Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
                           "  (swig-initialize obj initargs ", NIL);
      if (constructor_arg_types) {
        String *initfunc_name = NewStringf("%s@@SWIG@initmethod", class_name);
        String *func_call = buildClosFunctionCall(constructor_arg_types, initfunc_name, chickenPrimitiveName(constructor_name));
        Printf(clos_methods, "%s)\n)\n", initfunc_name);
        Printf(clos_methods, "(declare (hide %s))\n", initfunc_name);
        Printf(clos_methods, "%s\n", func_call);
        Delete(func_call);
        Delete(initfunc_name);
        Delete(constructor_arg_types);
        constructor_arg_types = 0;
      } else if (constructor_dispatch) {
        Printf(clos_methods, "%s)\n)\n", constructor_dispatch);
        Delete(constructor_dispatch);
        constructor_dispatch = 0;
      } else {
        Printf(clos_methods, "%s)\n)\n", chickenPrimitiveName(constructor_name));
      }
      Delete(constructor_name);
      constructor_name = 0;
  } else {
      Printv(clos_methods, "(define-method (initialize (obj ", class_name, ") initargs)\n",
                           "  (swig-initialize obj initargs (lambda x #f)))\n",
                           NIL);
  }

  /* export class initialization function */
  if (clos) {
      String *funcname = NewString(mangled_classname);
      Printf(funcname, "_swig_chicken_setclosclass");
      String *closfuncname = NewString(funcname);
      Replaceall(closfuncname, "_", "-");

      Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n",
                         "static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n",
                         "  C_trace(\"", funcname, "\");\n",
                         "  if (argc!=3) C_bad_argc(argc,3);\n",
                         "  swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr,"->clientdata;\n",
                         "  cdata->gc_proxy_create = CHICKEN_new_gc_root();\n",
                         "  CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n",
                         "  C_kontinue(continuation, C_SCHEME_UNDEFINED);\n",
                         "}\n", NIL);
      addMethod(closfuncname, funcname);

      Printv(clos_methods, "(", chickenPrimitiveName(closfuncname), " (lambda (x) (make ", class_name, " 'swig-this x)))\n\n", NIL);

      Delete(closfuncname);
      Delete(funcname);
  }

  Delete(mangled_classname);
  Delete(swigtype_ptr);
  swigtype_ptr = 0;
                           
  Delete(class_name);
  Delete(short_class_name);
  class_name = 0;
  short_class_name = 0;

  return SWIG_OK;
}

int
CHICKEN::memberfunctionHandler(Node *n)
{
    String *iname = Getattr(n, "sym:name");
    String *proc = NewString(iname);
    Replaceall(proc, "_", "-");

    member_name = chickenNameMapping(proc, short_class_name);
    Language::memberfunctionHandler(n);
    Delete(member_name);
    member_name = NULL;
    Delete(proc);

    return SWIG_OK;
}

int
CHICKEN::staticmemberfunctionHandler(Node *n)
{
    String *iname = Getattr(n, "sym:name");
    String *proc = NewString(iname);
    Replaceall(proc, "_", "-");

    member_name = NewStringf("%s-%s", short_class_name, proc);
    Language::staticmemberfunctionHandler(n);
    Delete(member_name);
    member_name = NULL;
    Delete(proc);

    return SWIG_OK;
}

int
CHICKEN::membervariableHandler(Node *n)
{
  String *iname = Getattr(n,"sym:name");
  //String *pb = SwigType_typedef_resolve_all(SwigType_base(Getattr(n, "type")));

  Language::membervariableHandler(n);

  String *proc = NewString(iname);
  Replaceall(proc,"_","-");

  //Node *class_node = Swig_symbol_clookup(pb, Getattr(n, "sym:symtab"));
  Node *class_node = classLookup(Getattr(n, "type"));

  String *getfunc = NewStringf("%s-%s-get", short_class_name, proc);
  String *setfunc = NewStringf("%s-%s-set", short_class_name, proc);

  Printv(clos_class_defines,"        (list '", proc, " ':swig-virtual ':swig-get ", chickenPrimitiveName(getfunc), NIL);

  if (!Getattr(n,"feature:immutable")) {
      if (class_node) {
          Printv(clos_class_defines, " ':swig-set (lambda (x y) (", chickenPrimitiveName(setfunc), " x (slot-ref y 'swig-this))))\n", NIL);
      } else {
          Printv(clos_class_defines, " ':swig-set ", chickenPrimitiveName(setfunc), ")\n", NIL);
      }
  } else {
      Printf(clos_class_defines, ")\n");
  }

  Delete(proc);
  return SWIG_OK;
}

int
CHICKEN::staticmembervariableHandler(Node *n)
{
    String *iname = Getattr(n, "sym:name");
    String *proc = NewString(iname);
    Replaceall(proc, "_", "-");

    member_name = NewStringf("%s-%s", short_class_name, proc);
    Language::staticmembervariableHandler(n);
    Delete(member_name);
    member_name = NULL;
    Delete(proc);

    return SWIG_OK;
}

int
CHICKEN::constructorHandler(Node *n)
{
  have_constructor = 1;
  has_constructor_args = 0;


  exporting_constructor = true;
  Language::constructorHandler(n);
  exporting_constructor = false;

  has_constructor_args = 1;

  String *iname = Getattr(n,"sym:name");
  constructor_name = Swig_name_construct(iname);
  Replaceall(constructor_name, "_", "-");
  return SWIG_OK;
}

int CHICKEN::destructorHandler(Node *n) {
  exporting_destructor = true;
  Language::destructorHandler(n);
  exporting_destructor = false;
  return SWIG_OK;
}

int CHICKEN::importDirective(Node *n) {
  String *modname = Getattr(n, "module");
  if (modname && clos_uses) {
    
    // Find the module node for this imported module.  It should be the
    // first child but search just in case.
    Node* mod = firstChild(n);
    while (mod && Strcmp(nodeType(mod), "module") != 0)
      mod = nextSibling(mod);

    if (mod) {
      String *name = Getattr(mod, "name");
      if (name) {
        Printf(closprefix, "(declare (uses %s))\n", name);
      }
    }
  }

  return Language::importDirective(n);
}

String *CHICKEN::buildClosFunctionCall(List *types, String_or_char *closname, String_or_char *funcname) {
  String *method_signature = NewString("");
  String *func_args = NewString("");
  String *func_call = NewString("");

  Iterator arg_type;
  int arg_count = 0;
  int optional_arguments = 0;

  for (arg_type = First(types); arg_type.item; arg_type = Next(arg_type)) {
    if (Strcmp(arg_type.item, "^^##optional$$") == 0) {
      optional_arguments = 1;
    } else {
      Printf(method_signature, " (arg%i %s)", arg_count, arg_type.item);
      arg_type = Next(arg_type);
      if (!arg_type.item) break;

      String *arg = NewStringf("arg%i", arg_count);
      String *access_arg = Copy(arg_type.item);

      Replaceall(access_arg, "$input", arg);
      Printf(func_args, " %s", access_arg);

      Delete(arg);
      Delete(access_arg);
    }
    arg_count++;
  }

  if (optional_arguments) {
    Printf(func_call, "(define-method (%s %s . args) (apply %s %s args))", 
                      closname, method_signature, funcname, func_args);
  } else {
    Printf(func_call, "(define-method (%s %s) (%s %s))", 
                      closname, method_signature, funcname, func_args);
  }

  Delete(method_signature);
  Delete(func_args);

  return func_call;
}

extern "C" {

  /* compares based on non-primitive names */
  static int compareTypeListsHelper(const DOH *a, const DOH *b, int opt_equal) {
    List *la = (List *) a;
    List *lb = (List *) b;

    Iterator ia = First(la);
    Iterator ib = First(lb);

    while (ia.item && ib.item) {
      int ret = Strcmp(ia.item, ib.item);
      if (ret) return ret;
      ia = Next(Next(ia));
      ib = Next(Next(ib));
    }

    if (opt_equal && ia.item && Strcmp(ia.item, "^^##optional$$") == 0)
      return 0;
    if (ia.item)
      return -1;
    if (opt_equal && ib.item && Strcmp(ib.item, "^^##optional$$") == 0)
      return 0;
    if (ib.item)
      return 1;

    return 0;
  }

  static int compareTypeLists(const DOH *a, const DOH *b) {
    return compareTypeListsHelper(a, b, 0);
  }
}

void 
CHICKEN::dispatchFunction(Node *n)
{
  /* Last node in overloaded chain */

  int maxargs;
  String *tmp = NewString("");
  String *dispatch = 
    Swig_overload_dispatch(n,"%s (2+$numargs,closure,"
                           "continuation$commaargs);", &maxargs);
        
  /* Generate a dispatch wrapper for all overloaded functions */

  Wrapper *f       = NewWrapper();
  String  *iname = Getattr(n,"sym:name");
  String  *wname   = NewString("");
  String  *scmname = NewString(iname);
  Replaceall(scmname, "_", "-");

  Append(wname, Swig_name_wrapper(iname));

  Printv(f->def, "static void real_", wname, 
         "(C_word, C_word, C_word, C_word) C_noret;\n", NIL);

  Printv(f->def, 
         "static void real_",
         wname,
         "(C_word oldargc, C_word closure, C_word continuation, C_word args) {",
         NIL);
    
  Wrapper_add_local(f,"argc","int argc");
  Printf(tmp,"C_word argv[%d]", maxargs+1);
  Wrapper_add_local(f,"argv",tmp);
  Wrapper_add_local(f,"ii","int ii");
  Wrapper_add_local(f,"t","C_word t = args");
  Printf(f->code,"if (!C_swig_is_list (args)) {\n");
  Printf(f->code,"  swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "
         "\"Argument #1 must be a list of overloaded arguments\");\n");
  Printf(f->code,"}\n");
  Printf(f->code,"argc = C_unfix (C_i_length (args));\n");
  Printf(f->code,"for (ii = 0; (ii < argc) && (ii < %d); ii++, t = C_block_item (t, 1)) {\n",maxargs);
  Printf(f->code,"argv[ii] = C_block_item (t, 0);\n");
  Printf(f->code,"}\n");
    
  Printv(f->code,dispatch,"\n",NIL);
  Printf(f->code,"swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,"
         "\"No matching function for overloaded '%s'\");\n", iname);
  Printv(f->code,"}\n",NIL);
  Wrapper_print(f,f_wrappers);
  addMethod(scmname, wname);

  DelWrapper(f);
  f = NewWrapper();

  /* varargs */
  Printv(f->def, "void ", wname, 
         "(C_word, C_word, C_word, ...) C_noret;\n", NIL);
  Printv(f->def, "void ", wname,
         "(C_word c, C_word t0, C_word t1, ...) {",
         NIL);
  Printv(f->code, 
         "C_word t2;\n",
         "va_list v;\n",
         "C_word *a, c2 = c;\n",
         "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);
  Printv(f->code,"}\n",NIL);
  Wrapper_print(f,f_wrappers);

  /* Now deal with overloaded function when exporting clos */
  if (clos) {
    List *flist = Getattr(overload_parameter_lists, scmname);
    if (flist) {
      Delattr(overload_parameter_lists, scmname);

      SortList(flist, compareTypeLists);

      String *clos_name;
      int construct = 0;
      if (have_constructor && !has_constructor_args) {
          has_constructor_args = 1;
          constructor_dispatch = NewStringf("%s@SWIG@new@dispatch", short_class_name);
          clos_name = Copy(constructor_dispatch);
          construct = 1;
          Printf(clos_methods, "(declare (hide %s))\n", clos_name);
      } else if (in_class)
          clos_name = NewString(member_name);
      else
          clos_name = chickenNameMapping(scmname, (char *)"");
      
      Iterator f;
      List *prev = 0;
      int all_primitive = 1;

      /* first check for duplicates and an empty call */
      String *newlist = NewList();
      for (f = First(flist); f.item; f = Next(f)) {
        /* check if cur is a duplicate of prev */
        if (prev && compareTypeListsHelper(f.item, prev, 1) == 0) {
          Delete(f.item);
        } else {
          Append(newlist, f.item);
          prev = f.item;
          Iterator j;
          for (j = First(f.item); j.item; j = Next(j)) {
            if (Strcmp(j.item, "^^##optional$$") != 0 && Strcmp(j.item, "<top>") != 0)
              all_primitive = 0;
          }
        }
      }
      Delete(flist);
      flist = newlist;
      
      if (all_primitive) {
        Printf(clos_methods, "(define %s %s)\n", clos_name, chickenPrimitiveName(scmname));
      } else {
        for (f = First(flist); f.item; f = Next(f)) {
          /* now export clos code for argument */
          String *func_call = buildClosFunctionCall(f.item, clos_name, chickenPrimitiveName(scmname));
          Printf(clos_methods, "%s\n", func_call);
          Delete(f.item);
          Delete(func_call);
        }
      }

      Delete(clos_name);
      Delete(flist);
    }
  }
        
  DelWrapper(f);
  Delete(dispatch);
  Delete(tmp);
  Delete(wname);
}

int
CHICKEN::isPointer(SwigType *t)
{
  return SwigType_ispointer(SwigType_typedef_resolve_all(t));
}

void 
CHICKEN::addMethod(String *scheme_name, String *function) 
{
  String *sym = NewString("");
  if (clos) {
      Append(sym, "primitive:");
  }
  Append(sym, scheme_name);

  /* add symbol to Chicken internal symbol table */
  if (hide_primitive) {
    Printv(f_init, "{\n",
                   "  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);
  } else {
    Printf(f_sym_size, "+C_SIZEOF_INTERNED_SYMBOL(%d)", Len(sym));    
    Printf(f_init, "sym = C_intern (&a, %d, \"%s\");\n", 
           Len(sym), sym);
    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);
  } 

  if (hide_primitive) {
    Setattr(primitive_names, scheme_name, NewStringf("(vector-ref swig-init-return %i)", num_methods));
  } else {
    Setattr(primitive_names, scheme_name, Copy(sym));
  }

  num_methods++;

  Delete(sym);
}

String *
CHICKEN::chickenPrimitiveName(String *name) {
  String *value = Getattr(primitive_names, name);
  if (value)
    return value;
  else {
    Swig_error(input_file, line_number, "Internal Error: attempting to reference non-existant primitive name %s\n", name);
    return NewString("#f");
  }
}
  
int
CHICKEN::validIdentifier(String *s) 
{
  char *c = Char(s);
  /* Check whether we have an R5RS identifier.*/
  /* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
  /* <initial> --> <letter> | <special initial> */
  if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
        || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
        || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
        || (*c == '^') || (*c == '_') || (*c == '~'))) {
    /* <peculiar identifier> --> + | - | ... */
    if ((strcmp(c, "+") == 0)
        || strcmp(c, "-") == 0
        || strcmp(c, "...") == 0) return 1;
    else return 0;
  }
  /* <subsequent> --> <initial> | <digit> | <special subsequent> */
  while (*c) {
    if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
          || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
          || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
          || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
          || (*c == '-') || (*c == '.') || (*c == '@'))) return 0;
    c++;
  }
  return 1;
}

  /* ------------------------------------------------------------
   * closNameMapping()
   * Maps the identifier from C++ to the CLOS based on command 
   * line paramaters and such.
   * If class_name = "" that means the mapping is for a function or
   * variable not attached to any class.
   * ------------------------------------------------------------ */
  String *CHICKEN::chickenNameMapping(String *name, String_or_char *class_name) {
    String *n = NewString("");
    
    if (Strcmp(class_name, "") == 0) {
      // not part of a class, so no class name to prefix
      if (clossymnameprefix) {
        Printf(n, "%s%s", clossymnameprefix, name);
      } else {
        Printf(n, "%s", name);
      }
    } else {
      if (useclassprefix) {
        Printf(n, "%s-%s", class_name, name);
      } else {
        if (clossymnameprefix) {
          Printf(n, "%s%s", clossymnameprefix, name);
        } else {
          Printf(n, "%s", name);
        }
      }
    }
    return n;
  }

  String *CHICKEN::runtimeCode() {
    String *s = Swig_include_sys("chickenrun.swg");
    if (!s) {
      Printf(stderr, "*** Unable to open 'chickenrun.swg'\n");
      s = NewString("");
    }
    return s;
  }

  String *CHICKEN::defaultExternalRuntimeFilename() {
    return NewString("swigchickenrun.h");
  }