PageRenderTime 79ms CodeModel.GetById 8ms app.highlight 61ms RepoModel.GetById 1ms app.codeStats 0ms

/tags/rel-1-3-26/SWIG/Source/Modules/mzscheme.cxx

#
C++ | 827 lines | 564 code | 148 blank | 115 comment | 165 complexity | dfbda15d6615a3a764dc7f8307aff343 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  1/******************************************************************************
  2 * Simplified Wrapper and Interface Generator  (SWIG)
  3 *
  4 * Author : David Beazley
  5 *
  6 * Department of Computer Science
  7 * University of Chicago
  8 * 1100 E 58th Street
  9 * Chicago, IL  60637
 10 * beazley@cs.uchicago.edu
 11 *
 12 * Please read the file LICENSE for the copyright and terms by which SWIG
 13 * can be used and distributed.
 14 *****************************************************************************/
 15
 16char cvsroot_mzscheme_cxx[] = "$Header$";
 17
 18/***********************************************************************
 19 * $Header$
 20 *
 21 * mzscheme.cxx
 22 *
 23 * Definitions for adding functions to Mzscheme 101
 24 ***********************************************************************/
 25
 26#include "swigmod.h"
 27
 28#include <ctype.h>
 29
 30static const char *usage = (char*)"\
 31Mzscheme Options (available with -mzscheme)\n\
 32     -prefix <name>  - Set a prefix <name> to be prepended to all names\n\
 33     -declaremodule  - Create extension that declares a module\n\
 34     -noinit         - Do not emit scheme_initialize, scheme_reload,\n\
 35                       scheme_module_name functions\n";
 36
 37static String     *fieldnames_tab = 0;
 38static String     *convert_tab = 0;
 39static String     *convert_proto_tab = 0;
 40static String     *struct_name = 0;
 41static String     *mangled_struct_name = 0;
 42
 43static char *prefix=0;
 44static bool declaremodule = false;
 45static bool noinit = false;
 46static String *module=0;
 47static char *mzscheme_path=(char*)"mzscheme";
 48static String *init_func_def = 0;
 49
 50static  File         *f_runtime = 0;
 51static  File         *f_header = 0;
 52static  File         *f_wrappers = 0;
 53static  File         *f_init = 0;
 54
 55// Used for garbage collection
 56static int     exporting_destructor = 0;
 57static String *swigtype_ptr = 0;
 58static String *cls_swigtype = 0;
 59
 60class MZSCHEME : public Language {
 61public:
 62
 63  /* ------------------------------------------------------------
 64   * main()
 65   * ------------------------------------------------------------ */
 66
 67  virtual void main (int argc, char *argv[]) {
 68
 69    int i;
 70    
 71    SWIG_library_directory(mzscheme_path);
 72    
 73    // Look for certain command line options
 74    for (i = 1; i < argc; i++) {
 75      if (argv[i]) {
 76	if (strcmp (argv[i], "-help") == 0) {
 77	  fputs (usage, stdout);
 78	  SWIG_exit (0);
 79	} else if (strcmp (argv[i], "-prefix") == 0) {
 80	  if (argv[i + 1]) {
 81	    prefix = new char[strlen(argv[i + 1]) + 2];
 82	    strcpy(prefix, argv[i + 1]);
 83	    Swig_mark_arg (i);
 84	    Swig_mark_arg (i + 1);
 85	    i++;
 86	  } else {
 87	    Swig_arg_error();
 88	  }
 89	} else if (strcmp (argv[i], "-declaremodule") == 0) {
 90		declaremodule = true;
 91		Swig_mark_arg (i);
 92	} else if (strcmp (argv[i], "-noinit") == 0) {
 93	  noinit = true;
 94	  Swig_mark_arg (i);
 95	}
 96      }
 97    }
 98    
 99    // If a prefix has been specified make sure it ends in a '_'
100    
101    if (prefix) {
102      if (prefix[strlen (prefix)] != '_') {
103	prefix[strlen (prefix) + 1] = 0;
104	prefix[strlen (prefix)] = '_';
105      }
106    } else
107      prefix = (char*)"swig_";
108    
109    // Add a symbol for this module
110    
111    Preprocessor_define ("SWIGMZSCHEME 1",0);
112    
113    // Set name of typemaps
114    
115    SWIG_typemap_lang("mzscheme");
116
117    // Read in default typemaps */
118    SWIG_config_file("mzscheme.swg");
119    allow_overloading();
120
121  }
122  
123  /* ------------------------------------------------------------
124   * top()
125   * ------------------------------------------------------------ */
126
127  virtual int top(Node *n) {
128
129    /* Initialize all of the output files */
130    String *outfile = Getattr(n,"outfile");
131    
132    f_runtime = NewFile(outfile,"w");
133    if (!f_runtime) {
134      FileErrorDisplay(outfile);
135      SWIG_exit(EXIT_FAILURE);
136    }
137    f_init = NewString("");
138    f_header = NewString("");
139    f_wrappers = NewString("");
140    
141    /* Register file targets with the SWIG file handler */
142    Swig_register_filebyname("header",f_header);
143    Swig_register_filebyname("wrapper",f_wrappers);
144    Swig_register_filebyname("runtime",f_runtime);
145    
146    init_func_def = NewString("");
147    Swig_register_filebyname("init",init_func_def);
148    
149    Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
150    Swig_banner (f_runtime);
151    
152    module = Getattr(n,"name");
153    
154    Language::top(n);
155    
156    SwigType_emit_type_table (f_runtime, f_wrappers);
157    if (!noinit) {
158      if (declaremodule) {
159        Printf(f_init, "#define SWIG_MZSCHEME_CREATE_MENV(env) scheme_primitive_module(scheme_intern_symbol(\"%s\"), env)\n", module);
160      }
161      else {
162	Printf(f_init,"#define SWIG_MZSCHEME_CREATE_MENV(env) (env)\n");
163      }
164      Printf(f_init, "%s\n", Char(init_func_def));
165      if (declaremodule) {
166        Printf(f_init, "\tscheme_finish_primitive_module(menv);\n");
167      }
168      Printf (f_init, "\treturn scheme_void;\n}\n");
169      Printf(f_init, "Scheme_Object *scheme_initialize(Scheme_Env *env) {\n");
170      Printf(f_init, "\treturn scheme_reload(env);\n");
171      Printf (f_init, "}\n");
172    
173      Printf(f_init,"Scheme_Object *scheme_module_name(void) {\n");
174      if (declaremodule) {
175        Printf(f_init, "   return scheme_intern_symbol((char*)\"%s\");\n", module);
176      } else {
177        Printf(f_init,"   return scheme_make_symbol((char*)\"%s\");\n", module);
178      }
179      Printf(f_init,"}\n");
180    }
181
182    /* Close all of the files */
183    Dump(f_header,f_runtime);
184    Dump(f_wrappers,f_runtime);
185    Wrapper_pretty_print(f_init,f_runtime);
186    Delete(f_header);
187    Delete(f_wrappers);
188    Delete(f_init);
189    Close(f_runtime);
190    Delete(f_runtime);
191    return SWIG_OK;
192  }
193  
194  /* ------------------------------------------------------------
195   * functionWrapper()
196   * Create a function declaration and register it with the interpreter.
197   * ------------------------------------------------------------ */
198
199  void throw_unhandled_mzscheme_type_error (SwigType *d)
200  {
201    Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number,
202		 "Unable to handle type %s.\n", SwigType_str(d,0));
203  }
204
205  /* Return true iff T is a pointer type */
206
207  int
208  is_a_pointer (SwigType *t)
209  {
210    return SwigType_ispointer(SwigType_typedef_resolve_all(t));
211  }
212
213  virtual int functionWrapper(Node *n) {
214    char *iname = GetChar(n,"sym:name");
215    SwigType *d = Getattr(n,"type");
216    ParmList *l = Getattr(n,"parms");
217    Parm *p;
218    
219    Wrapper *f = NewWrapper();
220    String *proc_name = NewString("");
221    String *source = NewString("");
222    String *target = NewString("");
223    String *arg = NewString("");
224    String *cleanup = NewString("");
225    String *outarg = NewString("");
226    String *build = NewString("");
227    String   *tm;
228    int argout_set = 0;
229    int i = 0;
230    int numargs;
231    int numreq;
232    String *overname = 0;
233
234    // Make a wrapper name for this
235    String *wname = Swig_name_wrapper(iname);
236    if (Getattr(n,"sym:overloaded")) {
237      overname = Getattr(n,"sym:overname");
238    } else {
239      if (!addSymbol(iname,n)) return SWIG_ERROR;
240    }
241    if (overname) {
242      Append(wname, overname);
243    }
244    Setattr(n,"wrap:name",wname);
245    
246    // Build the name for Scheme.
247    Printv(proc_name, iname,NIL);
248    Replaceall(proc_name, "_", "-");
249    
250    // writing the function wrapper function
251    Printv(f->def, "static Scheme_Object *",  wname, " (", NIL);
252    Printv(f->def, "int argc, Scheme_Object **argv", NIL);
253    Printv(f->def, ")\n{", NIL);
254    
255    /* Define the scheme name in C. This define is used by several
256       macros. */
257    Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
258    
259    // Declare return variable and arguments
260    // number of parameters
261    // they are called arg0, arg1, ...
262    // the return value is called result
263    
264    emit_args(d, l, f);
265    
266    /* Attach the standard typemaps */
267    emit_attach_parmmaps(l,f);
268    Setattr(n,"wrap:parms",l);
269    
270    numargs = emit_num_arguments(l);
271    numreq  = emit_num_required(l);
272    
273    // adds local variables
274    Wrapper_add_local(f, "lenv", "int lenv = 1");
275    Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
276    
277    // Now write code to extract the parameters (this is super ugly)
278    
279    for (i = 0, p = l; i < numargs; i++) {
280      /* Skip ignored arguments */
281
282      while (checkAttribute(p,"tmap:in:numinputs","0")) {
283	p = Getattr(p,"tmap:in:next");
284      }
285      
286      SwigType *pt = Getattr(p,"type");
287      String   *ln = Getattr(p,"lname");
288      
289      // Produce names of source and target
290      Clear(source);
291      Clear(target);
292      Clear(arg);
293      Printf(source, "argv[%d]", i);
294      Printf(target, "%s",ln);
295      Printv(arg, Getattr(p,"name"),NIL);
296      
297      if (i >= numreq) {
298	Printf(f->code,"if (argc > %d) {\n",i);
299      }
300      // Handle parameter types.
301      if ((tm = Getattr(p,"tmap:in"))) {
302	Replaceall(tm,"$source",source);
303	Replaceall(tm,"$target",target);
304	Replaceall(tm,"$input",source);
305	Setattr(p,"emit:input",source);
306	Printv(f->code, tm, "\n", NIL);
307	p = Getattr(p,"tmap:in:next");
308      } else {
309	// no typemap found
310	// check if typedef and resolve
311	throw_unhandled_mzscheme_type_error (pt);
312	p = nextSibling(p);
313      }
314      if (i >= numreq) {
315	Printf(f->code,"}\n");
316      }
317    }
318    
319    /* Insert constraint checking code */
320    for (p = l; p;) {
321      if ((tm = Getattr(p,"tmap:check"))) {
322	Replaceall(tm,"$target",Getattr(p,"lname"));
323	Printv(f->code,tm,"\n",NIL);
324	p = Getattr(p,"tmap:check:next");
325      } else {
326	p = nextSibling(p);
327      }
328    }
329    
330    // Pass output arguments back to the caller.
331    
332    for (p = l; p;) {
333      if ((tm = Getattr(p,"tmap:argout"))) {
334	Replaceall(tm,"$source",Getattr(p,"emit:input"));   /* Deprecated */
335	Replaceall(tm,"$target",Getattr(p,"lname"));   /* Deprecated */
336	Replaceall(tm,"$arg",Getattr(p,"emit:input"));
337	Replaceall(tm,"$input",Getattr(p,"emit:input"));
338	Printv(outarg,tm,"\n",NIL);
339	p = Getattr(p,"tmap:argout:next");
340	argout_set = 1;
341      } else {
342	p = nextSibling(p);
343      }
344    }
345    
346    // Free up any memory allocated for the arguments.
347    
348    /* Insert cleanup code */
349    for (p = l; p;) {
350      if ((tm = Getattr(p,"tmap:freearg"))) {
351	Replaceall(tm,"$target",Getattr(p,"lname"));
352	Printv(cleanup,tm,"\n",NIL);
353	p = Getattr(p,"tmap:freearg:next");
354      } else {
355	p = nextSibling(p);
356      }
357    }
358    
359    // Now write code to make the function call
360    
361    emit_action(n,f);
362    
363    // Now have return value, figure out what to do with it.
364    
365    if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
366      Replaceall(tm,"$source","result");
367      Replaceall(tm,"$target","values[0]");
368      Replaceall(tm,"$result","values[0]");
369      if (GetFlag(n, "feature:new"))
370        Replaceall(tm, "$owner", "1");
371      else
372        Replaceall(tm, "$owner", "0");
373      Printv(f->code, tm, "\n",NIL);
374    } else {
375      throw_unhandled_mzscheme_type_error (d);
376    }
377    
378    // Dump the argument output code
379    Printv(f->code, Char(outarg),NIL);
380    
381    // Dump the argument cleanup code
382    Printv(f->code, Char(cleanup),NIL);
383    
384    // Look for any remaining cleanup
385    
386    if (GetFlag(n,"feature:new")) {
387      if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) {
388	Replaceall(tm,"$source","result");
389	Printv(f->code, tm, "\n",NIL);
390      }
391    }
392    
393    // Free any memory allocated by the function being wrapped..
394    
395    if ((tm = Swig_typemap_lookup_new("ret",n,"result",0))) {
396      Replaceall(tm,"$source","result");
397      Printv(f->code, tm, "\n",NIL);
398    }
399    
400    // Wrap things up (in a manner of speaking)
401    
402    Printv(f->code, tab4, "return SWIG_MzScheme_PackageValues(lenv, values);\n", NIL);
403    Printf(f->code, "#undef FUNC_NAME\n");
404    Printv(f->code, "}\n",NIL);
405    
406    Wrapper_print(f, f_wrappers);
407   
408    if (!Getattr(n,"sym:overloaded")) {
409 
410      // Now register the function
411      char temp[256];
412      sprintf(temp, "%d", numargs);
413      if (exporting_destructor) {
414        Printf(init_func_def, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname);
415      } else {
416        Printf(init_func_def, "scheme_add_global(\"%s\", scheme_make_prim_w_arity(%s,\"%s\",%d,%d),menv);\n",
417	       proc_name, wname, proc_name, numreq, numargs);
418      }
419    } else {
420      if (!Getattr(n,"sym:nextSibling")) {
421	/* Emit overloading dispatch function */
422
423	int maxargs;
424	String *dispatch = Swig_overload_dispatch(n,"return %s(argc,argv);",&maxargs);
425	
426	/* Generate a dispatch wrapper for all overloaded functions */
427
428	Wrapper *df      = NewWrapper();
429	String  *dname   = Swig_name_wrapper(iname);
430
431	Printv(df->def,	
432	       "static Scheme_Object *\n", dname,
433	       "(int argc, Scheme_Object **argv) {",
434	       NIL);
435	Printv(df->code,dispatch,"\n",NIL);
436	Printf(df->code,"scheme_signal_error(\"No matching function for overloaded '%s'\");\n", iname);
437	Printv(df->code,"}\n",NIL);
438	Wrapper_print(df,f_wrappers);
439	Printf(init_func_def, "scheme_add_global(\"%s\", scheme_make_prim_w_arity(%s,\"%s\",%d,%d),menv);\n",
440	     proc_name, dname, proc_name, 0, maxargs);
441	DelWrapper(df);
442	Delete(dispatch);
443	Delete(dname);
444      }
445    }
446    
447    Delete(proc_name);
448    Delete(source);
449    Delete(target);
450    Delete(arg);
451    Delete(outarg);
452    Delete(cleanup);
453    Delete(build);
454    DelWrapper(f);
455    return SWIG_OK;
456  }
457
458  /* ------------------------------------------------------------
459   * variableWrapper()
460   *
461   * Create a link to a C variable.
462   * This creates a single function _wrap_swig_var_varname().
463   * This function takes a single optional argument.   If supplied, it means
464   * we are setting this variable to some value.  If omitted, it means we are
465   * simply evaluating this variable.  Either way, we return the variables
466   * value.
467   * ------------------------------------------------------------ */
468
469  virtual int variableWrapper(Node *n)  {
470
471    char *name  = GetChar(n,"name");
472    char *iname = GetChar(n,"sym:name");
473    SwigType *t = Getattr(n,"type");
474    
475    String *proc_name = NewString("");
476    char  var_name[256];
477    String *tm;
478    String *tm2 = NewString("");;
479    String *argnum = NewString("0");
480    String *arg = NewString("argv[0]");
481    Wrapper *f;
482    
483    if (!addSymbol(iname,n)) return SWIG_ERROR;
484    
485    f = NewWrapper();
486    
487    // evaluation function names
488    
489    strcpy(var_name, Char(Swig_name_wrapper(iname)));
490    
491    // Build the name for scheme.
492    Printv(proc_name, iname,NIL);
493    Replaceall(proc_name, "_", "-");
494    
495    if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {
496      
497      Printf (f->def, "static Scheme_Object *%s(int argc, Scheme_Object** argv) {\n", var_name);
498      Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
499      
500      Wrapper_add_local (f, "swig_result", "Scheme_Object *swig_result");
501      
502      if (!GetFlag(n,"feature:immutable")) {
503	/* Check for a setting of the variable value */
504	Printf (f->code, "if (argc) {\n");
505	if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
506	  Replaceall(tm,"$source","argv[0]");
507	  Replaceall(tm,"$target",name);
508	  Replaceall(tm,"$input","argv[0]");
509	  Printv(f->code, tm, "\n",NIL);
510	}
511	else {
512	  throw_unhandled_mzscheme_type_error (t);
513	}
514	Printf (f->code, "}\n");
515      }
516      
517      // Now return the value of the variable (regardless
518      // of evaluating or setting)
519      
520      if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
521	Replaceall(tm,"$source",name);
522	Replaceall(tm,"$target","swig_result");
523	Replaceall(tm,"$result","swig_result");
524	Printf (f->code, "%s\n", tm);
525      }
526      else {
527	throw_unhandled_mzscheme_type_error (t);
528      }
529      Printf (f->code, "\nreturn swig_result;\n");
530      Printf (f->code, "#undef FUNC_NAME\n");
531      Printf (f->code, "}\n");
532      
533      Wrapper_print (f, f_wrappers);
534      
535      // Now add symbol to the MzScheme interpreter
536      
537      Printv(init_func_def,
538	     "scheme_add_global(\"",
539	     proc_name,
540	     "\", scheme_make_prim_w_arity(",
541	     var_name,
542	     ", \"",
543	     proc_name,
544	     "\", ",
545	     "0",
546	     ", ",
547	     "1",
548	     "), menv);\n",NIL);
549      
550    } else {
551      Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
552		   "Unsupported variable type %s (ignored).\n", SwigType_str(t,0));
553    }
554    Delete(proc_name);
555    Delete(argnum);
556    Delete(arg);
557    Delete(tm2);
558    DelWrapper(f);
559    return SWIG_OK;
560  }
561
562  /* ------------------------------------------------------------
563   * constantWrapper()
564   * ------------------------------------------------------------ */
565
566  virtual int constantWrapper(Node *n) {
567    char *name      = GetChar(n,"name");
568    char *iname     = GetChar(n,"sym:name");
569    SwigType *type  = Getattr(n,"type");
570    String   *value = Getattr(n,"value");
571    
572    String *var_name = NewString("");
573    String *proc_name = NewString("");
574    String *rvalue = NewString("");
575    String *temp = NewString("");
576    String *tm;
577    
578    // Make a static variable;
579    
580    Printf (var_name, "_wrap_const_%s", Swig_name_mangle(Getattr(n,"sym:name")));
581    
582    // Build the name for scheme.
583    Printv(proc_name, iname,NIL);
584    Replaceall(proc_name, "_", "-");
585    
586    if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
587      Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number,
588		   "Unsupported constant value.\n");
589      return SWIG_NOWRAP;
590    }
591    
592    // See if there's a typemap
593    
594    Printv(rvalue, value,NIL);
595    if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 1)) {
596      temp = Copy(rvalue);
597      Clear(rvalue);
598      Printv(rvalue, "\"", temp, "\"",NIL);
599    }
600    if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 0)) {
601      Delete(temp);
602      temp = Copy(rvalue);
603      Clear(rvalue);
604      Printv(rvalue, "'", temp, "'",NIL);
605    }
606    if ((tm = Swig_typemap_lookup_new("constant",n,name,0))) {
607      Replaceall(tm,"$source",rvalue);
608      Replaceall(tm,"$value",rvalue);
609      Replaceall(tm,"$target",name);
610      Printf (f_init, "%s\n", tm);
611    } else {
612      // Create variable and assign it a value
613      
614      Printf (f_header, "static %s = ", SwigType_lstr(type,var_name));
615      if ((SwigType_type(type) == T_STRING)) {
616	Printf (f_header, "\"%s\";\n", value);
617      } else if (SwigType_type(type) == T_CHAR) {
618	Printf (f_header, "\'%s\';\n", value);
619      } else {
620	Printf (f_header, "%s;\n", value);
621      }
622      
623      // Now create a variable declaration
624      
625      {
626	/* Hack alert: will cleanup later -- Dave */
627	Node *n = NewHash();
628	Setattr(n,"name",var_name);
629	Setattr(n,"sym:name",iname);
630	Setattr(n,"type", type);
631	variableWrapper(n);
632	Delete(n);
633      }
634    }
635    Delete(proc_name);
636    Delete(rvalue);
637    Delete(temp);
638    return SWIG_OK;
639  }
640
641  virtual int destructorHandler(Node *n) {
642    exporting_destructor = true;
643    Language::destructorHandler(n);
644    exporting_destructor = false;
645    return SWIG_OK;
646  }
647
648  /* ------------------------------------------------------------
649   * classHandler()
650   * ------------------------------------------------------------ */
651  virtual int classHandler(Node *n) {
652      String     *mangled_classname = 0;
653      String     *real_classname = 0;
654      String     *scm_structname = NewString("");
655      SwigType   *ctype_ptr = NewStringf("p.%s", Getattr(n, "classtype"));
656      
657      SwigType *t = NewStringf("p.%s", Getattr(n, "name"));
658      swigtype_ptr = SwigType_manglestr(t);
659      Delete(t);
660
661      cls_swigtype = SwigType_manglestr(Getattr(n, "name"));
662
663
664      fieldnames_tab       = NewString("");
665      convert_tab          = NewString("");
666      convert_proto_tab    = NewString("");
667
668      struct_name = Getattr(n,"sym:name");
669      mangled_struct_name = Swig_name_mangle(Getattr(n,"sym:name"));
670
671      Printv(scm_structname, struct_name, NIL);
672      Replaceall(scm_structname, "_", "-");
673      
674      real_classname = Getattr(n,"name");
675      mangled_classname = Swig_name_mangle(real_classname);
676
677      Printv(fieldnames_tab, "static const char *_swig_struct_", 
678             cls_swigtype, "_field_names[] = { \n", NIL);
679
680      Printv(convert_proto_tab, "static Scheme_Object *_swig_convert_struct_",
681             cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ");\n", NIL);
682      
683      Printv(convert_tab, "static Scheme_Object *_swig_convert_struct_",
684             cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ")\n {\n", 
685             NIL);
686
687      Printv(convert_tab, 
688             tab4, "Scheme_Object *obj;\n",
689             tab4, "Scheme_Object *fields[_swig_struct_", cls_swigtype, 
690             "_field_names_cnt];\n", 
691             tab4, "int i = 0;\n\n", NIL);
692
693      /* Generate normal wrappers */
694      Language::classHandler(n);
695
696      Printv(convert_tab, tab4, "obj = scheme_make_struct_instance(",
697             "_swig_struct_type_", cls_swigtype, ", i, fields);\n", NIL);
698      Printv(convert_tab, tab4, "return obj;\n}\n\n", NIL);
699
700      Printv(fieldnames_tab, "};\n", NIL);
701
702      Printv(f_header, "static Scheme_Object *_swig_struct_type_", 
703             cls_swigtype, ";\n", NIL);
704
705      Printv(f_header, fieldnames_tab, NIL);
706      Printv(f_header, "#define  _swig_struct_", cls_swigtype, 
707             "_field_names_cnt (sizeof(_swig_struct_", cls_swigtype, 
708             "_field_names)/sizeof(char*))\n", NIL);
709
710      Printv(f_header, convert_proto_tab, NIL);
711      Printv(f_wrappers, convert_tab, NIL);
712
713      Printv(init_func_def, "_swig_struct_type_", cls_swigtype,
714             " = SWIG_MzScheme_new_scheme_struct(menv, \"", scm_structname, "\", ", 
715             "_swig_struct_",  cls_swigtype, "_field_names_cnt,",
716             "(char**) _swig_struct_", cls_swigtype, "_field_names);\n", 
717             NIL);
718      
719      Delete(mangled_classname);
720      Delete(swigtype_ptr);
721      swigtype_ptr = 0;
722      Delete(fieldnames_tab);
723      Delete(convert_tab);
724      Delete(ctype_ptr);
725      Delete(convert_proto_tab);
726      struct_name = 0;
727      mangled_struct_name = 0;
728      Delete(cls_swigtype);
729      cls_swigtype = 0;
730
731      return SWIG_OK;
732  }
733    
734    /* ------------------------------------------------------------
735     * membervariableHandler()
736     * ------------------------------------------------------------ */
737
738    virtual int membervariableHandler(Node *n) {
739        Language::membervariableHandler(n);
740
741	if (!is_smart_pointer()) {
742	  String   *symname    = Getattr(n, "sym:name");
743	  String   *name       = Getattr(n, "name");
744	  SwigType *type       = Getattr(n, "type");
745	  String   *swigtype   = SwigType_manglestr(Getattr(n, "type"));
746	  String   *tm         = 0;
747	  String   *access_mem = NewString("");
748	  SwigType *ctype_ptr  = NewStringf("p.%s", Getattr(n, "type"));
749
750	  Printv(fieldnames_tab, tab4, "\"", symname, "\",\n", NIL);
751	  Printv(access_mem, "(ptr)->", name, NIL);
752	  if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) {
753            Printv(convert_tab, tab4, "fields[i++] = ", NIL);
754            Printv(convert_tab, "_swig_convert_struct_", swigtype, 
755                   "((",  SwigType_str(ctype_ptr, ""), ")&((ptr)->", 
756                   name, "));\n", NIL); 
757	  } else if ((tm = Swig_typemap_lookup_new("varout",n,access_mem,0))) {
758            Replaceall(tm,"$result","fields[i++]");
759            Printv(convert_tab, tm, "\n", NIL);
760	  } else
761            Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
762                         "Unsupported member variable type %s (ignored).\n", 
763                         SwigType_str(type,0));
764	  
765	  Delete(access_mem);
766	}
767        return SWIG_OK;
768    }
769
770
771  /* ------------------------------------------------------------
772   * validIdentifer()
773   * ------------------------------------------------------------ */
774  
775  virtual int validIdentifier(String *s) {
776    char *c = Char(s);
777    /* Check whether we have an R5RS identifier.*/
778    /* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
779    /* <initial> --> <letter> | <special initial> */
780    if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
781	  || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
782	  || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
783	  || (*c == '^') || (*c == '_') || (*c == '~'))) {
784      /* <peculiar identifier> --> + | - | ... */
785      if ((strcmp(c, "+") == 0)
786	  || strcmp(c, "-") == 0
787	  || strcmp(c, "...") == 0) return 1;
788      else return 0;
789    }
790    /* <subsequent> --> <initial> | <digit> | <special subsequent> */
791    while (*c) {
792      if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
793	    || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
794	    || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
795	    || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
796	    || (*c == '-') || (*c == '.') || (*c == '@'))) return 0;
797      c++;
798    }
799    return 1;
800  }
801
802  String *runtimeCode() {
803    String *s = Swig_include_sys("mzrun.swg");
804    if (!s) {
805      Printf(stderr, "*** Unable to open 'mzrun.swg'\n");
806      s = NewString("");
807    }
808    return s;
809  }
810
811  String *defaultExternalRuntimeFilename() {
812    return NewString("swigmzrun.h");
813  }
814};
815  
816/* -----------------------------------------------------------------------------
817 * swig_mzscheme()    - Instantiate module
818 * ----------------------------------------------------------------------------- */
819
820static Language * new_swig_mzscheme() {
821  return new MZSCHEME();
822}
823extern "C" Language * swig_mzscheme(void) {
824  return new_swig_mzscheme();
825}
826
827