← Back to branch summary

~ubuntu-branches/ubuntu/maverick/swig1.3/maverick

« back to all changes in this revision

Viewing changes to Source/Modules/mzscheme.cxx

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2006-12-20 14:43:24 UTC
  • mfrom: (1.2.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20061220144324-bps3kb06xp5oy9w1
Tags: 1.3.31-1ubuntu1
* Merge from debian unstable, remaining changes:
  - drop support for pike
  - use php5 instead of php4
  - clean Runtime/ as well
  - force a few environment variables

Show diffs side-by-side

added added

removed removed

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