/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