/* ----------------------------------------------------------------------------- * See the LICENSE file for information on copyright, usage and redistribution * of SWIG, and the README file for authors - http://www.swig.org/release.html. * * mzscheme.cxx * * Mzscheme language module for SWIG. * ----------------------------------------------------------------------------- */ char cvsroot_mzscheme_cxx[] = "$Id: mzscheme.cxx 11133 2009-02-20 07:52:24Z wsfulton $"; #include "swigmod.h" #include static const char *usage = (char *) "\ Mzscheme Options (available with -mzscheme)\n\ -prefix - Set a prefix to be prepended to all names\n\ -declaremodule - Create extension that declares a module\n\ -noinit - Do not emit scheme_initialize, scheme_reload,\n\ scheme_module_name functions\n\ -dynamic-load ,[library,...] - Do not link with these libraries, dynamic load\n\ them\n\ "; static String *fieldnames_tab = 0; static String *convert_tab = 0; static String *convert_proto_tab = 0; static String *struct_name = 0; static String *mangled_struct_name = 0; static char *prefix = 0; static bool declaremodule = false; static bool noinit = false; //DLOPEN PATCH static char *load_libraries = NULL; //DLOPEN PATCH static String *module = 0; static char *mzscheme_path = (char *) "mzscheme"; static String *init_func_def = 0; static File *f_begin = 0; static File *f_runtime = 0; static File *f_header = 0; static File *f_wrappers = 0; static File *f_init = 0; // Used for garbage collection static int exporting_destructor = 0; static String *swigtype_ptr = 0; static String *cls_swigtype = 0; class MZSCHEME:public Language { public: /* ------------------------------------------------------------ * main() * ------------------------------------------------------------ */ virtual void main(int argc, char *argv[]) { int i; SWIG_library_directory(mzscheme_path); // Look for certain command line options for (i = 1; i < argc; i++) { if (argv[i]) { if (strcmp(argv[i], "-help") == 0) { fputs(usage, stdout); SWIG_exit(0); } else if (strcmp(argv[i], "-prefix") == 0) { if (argv[i + 1]) { prefix = new char[strlen(argv[i + 1]) + 2]; strcpy(prefix, argv[i + 1]); Swig_mark_arg(i); Swig_mark_arg(i + 1); i++; } else { Swig_arg_error(); } } else if (strcmp(argv[i], "-declaremodule") == 0) { declaremodule = true; Swig_mark_arg(i); } else if (strcmp(argv[i], "-noinit") == 0) { noinit = true; Swig_mark_arg(i); } // DLOPEN PATCH else if (strcmp(argv[i], "-dynamic-load") == 0) { load_libraries = new char[strlen(argv[i + 1]) + 2]; strcpy(load_libraries, argv[i + 1]); Swig_mark_arg(i++); Swig_mark_arg(i); } // DLOPEN PATCH } } // If a prefix has been specified make sure it ends in a '_' if (prefix) { if (prefix[strlen(prefix)] != '_') { prefix[strlen(prefix) + 1] = 0; prefix[strlen(prefix)] = '_'; } } else prefix = (char *) "swig_"; // Add a symbol for this module Preprocessor_define("SWIGMZSCHEME 1", 0); // Set name of typemaps SWIG_typemap_lang("mzscheme"); // Read in default typemaps */ SWIG_config_file("mzscheme.swg"); allow_overloading(); } /* ------------------------------------------------------------ * top() * ------------------------------------------------------------ */ virtual int top(Node *n) { /* Initialize all of the output files */ String *outfile = Getattr(n, "outfile"); f_begin = NewFile(outfile, "w", SWIG_output_files()); if (!f_begin) { FileErrorDisplay(outfile); SWIG_exit(EXIT_FAILURE); } f_runtime = NewString(""); f_init = NewString(""); f_header = NewString(""); f_wrappers = NewString(""); /* Register file targets with the SWIG file handler */ Swig_register_filebyname("header", f_header); Swig_register_filebyname("wrapper", f_wrappers); Swig_register_filebyname("begin", f_begin); Swig_register_filebyname("runtime", f_runtime); init_func_def = NewString(""); Swig_register_filebyname("init", init_func_def); Swig_banner(f_begin); Printf(f_runtime, "\n"); Printf(f_runtime, "#define SWIGMZSCHEME\n"); Printf(f_runtime, "\n"); module = Getattr(n, "name"); Language::top(n); SwigType_emit_type_table(f_runtime, f_wrappers); if (!noinit) { if (declaremodule) { Printf(f_init, "#define SWIG_MZSCHEME_CREATE_MENV(env) scheme_primitive_module(scheme_intern_symbol(\"%s\"), env)\n", module); } else { Printf(f_init, "#define SWIG_MZSCHEME_CREATE_MENV(env) (env)\n"); } Printf(f_init, "%s\n", Char(init_func_def)); if (declaremodule) { Printf(f_init, "\tscheme_finish_primitive_module(menv);\n"); } Printf(f_init, "\treturn scheme_void;\n}\n"); Printf(f_init, "Scheme_Object *scheme_initialize(Scheme_Env *env) {\n"); // DLOPEN PATCH if (load_libraries) { Printf(f_init, "mz_set_dlopen_libraries(\"%s\");\n", load_libraries); } // DLOPEN PATCH Printf(f_init, "\treturn scheme_reload(env);\n"); Printf(f_init, "}\n"); Printf(f_init, "Scheme_Object *scheme_module_name(void) {\n"); if (declaremodule) { Printf(f_init, " return scheme_intern_symbol((char*)\"%s\");\n", module); } else { Printf(f_init, " return scheme_make_symbol((char*)\"%s\");\n", module); } Printf(f_init, "}\n"); } /* Close all of the files */ Dump(f_runtime, f_begin); Dump(f_header, f_begin); Dump(f_wrappers, f_begin); Wrapper_pretty_print(f_init, f_begin); Delete(f_header); Delete(f_wrappers); Delete(f_init); Close(f_begin); Delete(f_runtime); Delete(f_begin); return SWIG_OK; } /* ------------------------------------------------------------ * functionWrapper() * Create a function declaration and register it with the interpreter. * ------------------------------------------------------------ */ void throw_unhandled_mzscheme_type_error(SwigType *d) { Swig_warning(WARN_TYPEMAP_UNDEF, input_file, line_number, "Unable to handle type %s.\n", SwigType_str(d, 0)); } /* Return true iff T is a pointer type */ int is_a_pointer(SwigType *t) { return SwigType_ispointer(SwigType_typedef_resolve_all(t)); } virtual int functionWrapper(Node *n) { char *iname = GetChar(n, "sym:name"); SwigType *d = Getattr(n, "type"); ParmList *l = Getattr(n, "parms"); Parm *p; Wrapper *f = NewWrapper(); String *proc_name = NewString(""); String *source = NewString(""); String *target = NewString(""); String *arg = NewString(""); String *cleanup = NewString(""); String *outarg = NewString(""); String *build = NewString(""); String *tm; int argout_set = 0; int i = 0; int numargs; int numreq; String *overname = 0; // PATCH DLOPEN if (load_libraries) { ParmList *parms = Getattr(n, "parms"); SwigType *type = Getattr(n, "type"); String *name = NewString("caller"); Setattr(n, "wrap:action", Swig_cresult(type, "result", Swig_cfunction_call(name, parms))); } // PATCH DLOPEN // Make a wrapper name for this String *wname = Swig_name_wrapper(iname); if (Getattr(n, "sym:overloaded")) { overname = Getattr(n, "sym:overname"); } else { if (!addSymbol(iname, n)) { DelWrapper(f); return SWIG_ERROR; } } if (overname) { Append(wname, overname); } Setattr(n, "wrap:name", wname); // Build the name for Scheme. Printv(proc_name, iname, NIL); Replaceall(proc_name, "_", "-"); // writing the function wrapper function Printv(f->def, "static Scheme_Object *", wname, " (", NIL); Printv(f->def, "int argc, Scheme_Object **argv", NIL); Printv(f->def, ")\n{", NIL); /* Define the scheme name in C. This define is used by several macros. */ Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); // Emit all of the local variables for holding arguments. emit_parameter_variables(l, f); /* Attach the standard typemaps */ emit_attach_parmmaps(l, f); Setattr(n, "wrap:parms", l); numargs = emit_num_arguments(l); numreq = emit_num_required(l); // DLOPEN PATCH /* Add the holder for the pointer to the function to be opened */ if (load_libraries) { Wrapper_add_local(f, "_function_loaded", "static int _function_loaded=(1==0)"); Wrapper_add_local(f, "_the_function", "static void *_the_function=NULL"); { String *parms = ParmList_protostr(l); String *func = NewStringf("(*caller)(%s)", parms); Wrapper_add_local(f, "caller", SwigType_lstr(d, func)); /*"(*caller)()")); */ } } // DLOPEN PATCH // adds local variables Wrapper_add_local(f, "lenv", "int lenv = 1"); Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]"); // DLOPEN PATCH if (load_libraries) { Printf(f->code, "if (!_function_loaded) { _the_function=mz_load_function(\"%s\");_function_loaded=(1==1); }\n", iname); Printf(f->code, "if (!_the_function) { scheme_signal_error(\"Cannot load C function '%s'\"); }\n", iname); Printf(f->code, "caller=_the_function;\n"); } // DLOPEN PATCH // Now write code to extract the parameters (this is super ugly) for (i = 0, p = l; i < numargs; i++) { /* Skip ignored arguments */ while (checkAttribute(p, "tmap:in:numinputs", "0")) { p = Getattr(p, "tmap:in:next"); } SwigType *pt = Getattr(p, "type"); String *ln = Getattr(p, "lname"); // Produce names of source and target Clear(source); Clear(target); Clear(arg); Printf(source, "argv[%d]", i); Printf(target, "%s", ln); Printv(arg, Getattr(p, "name"), NIL); if (i >= numreq) { Printf(f->code, "if (argc > %d) {\n", i); } // Handle parameter types. if ((tm = Getattr(p, "tmap:in"))) { Replaceall(tm, "$source", source); Replaceall(tm, "$target", target); Replaceall(tm, "$input", source); Setattr(p, "emit:input", source); Printv(f->code, tm, "\n", NIL); p = Getattr(p, "tmap:in:next"); } else { // no typemap found // check if typedef and resolve throw_unhandled_mzscheme_type_error(pt); p = nextSibling(p); } if (i >= numreq) { Printf(f->code, "}\n"); } } /* Insert constraint checking code */ for (p = l; p;) { if ((tm = Getattr(p, "tmap:check"))) { Replaceall(tm, "$target", Getattr(p, "lname")); Printv(f->code, tm, "\n", NIL); p = Getattr(p, "tmap:check:next"); } else { p = nextSibling(p); } } // Pass output arguments back to the caller. for (p = l; p;) { if ((tm = Getattr(p, "tmap:argout"))) { Replaceall(tm, "$source", Getattr(p, "emit:input")); /* Deprecated */ Replaceall(tm, "$target", Getattr(p, "lname")); /* Deprecated */ Replaceall(tm, "$arg", Getattr(p, "emit:input")); Replaceall(tm, "$input", Getattr(p, "emit:input")); Printv(outarg, tm, "\n", NIL); p = Getattr(p, "tmap:argout:next"); argout_set = 1; } else { p = nextSibling(p); } } // Free up any memory allocated for the arguments. /* Insert cleanup code */ for (p = l; p;) { if ((tm = Getattr(p, "tmap:freearg"))) { Replaceall(tm, "$target", Getattr(p, "lname")); Printv(cleanup, tm, "\n", NIL); p = Getattr(p, "tmap:freearg:next"); } else { p = nextSibling(p); } } // Now write code to make the function call String *actioncode = emit_action(n); // Now have return value, figure out what to do with it. if ((tm = Swig_typemap_lookup_out("out", n, "result", f, actioncode))) { Replaceall(tm, "$source", "result"); Replaceall(tm, "$target", "values[0]"); Replaceall(tm, "$result", "values[0]"); if (GetFlag(n, "feature:new")) Replaceall(tm, "$owner", "1"); else Replaceall(tm, "$owner", "0"); Printv(f->code, tm, "\n", NIL); } else { throw_unhandled_mzscheme_type_error(d); } emit_return_variable(n, d, f); // Dump the argument output code Printv(f->code, Char(outarg), NIL); // Dump the argument cleanup code Printv(f->code, Char(cleanup), NIL); // Look for any remaining cleanup if (GetFlag(n, "feature:new")) { if ((tm = Swig_typemap_lookup("newfree", n, "result", 0))) { Replaceall(tm, "$source", "result"); Printv(f->code, tm, "\n", NIL); } } // Free any memory allocated by the function being wrapped.. if ((tm = Swig_typemap_lookup("ret", n, "result", 0))) { Replaceall(tm, "$source", "result"); Printv(f->code, tm, "\n", NIL); } // Wrap things up (in a manner of speaking) Printv(f->code, tab4, "return SWIG_MzScheme_PackageValues(lenv, values);\n", NIL); Printf(f->code, "#undef FUNC_NAME\n"); Printv(f->code, "}\n", NIL); /* Substitute the function name */ Replaceall(f->code, "$symname", iname); Wrapper_print(f, f_wrappers); if (!Getattr(n, "sym:overloaded")) { // Now register the function char temp[256]; sprintf(temp, "%d", numargs); if (exporting_destructor) { Printf(init_func_def, "SWIG_TypeClientData(SWIGTYPE%s, (void *) %s);\n", swigtype_ptr, wname); } else { 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); } } else { if (!Getattr(n, "sym:nextSibling")) { /* Emit overloading dispatch function */ int maxargs; String *dispatch = Swig_overload_dispatch(n, "return %s(argc,argv);", &maxargs); /* Generate a dispatch wrapper for all overloaded functions */ Wrapper *df = NewWrapper(); String *dname = Swig_name_wrapper(iname); Printv(df->def, "static Scheme_Object *\n", dname, "(int argc, Scheme_Object **argv) {", NIL); Printv(df->code, dispatch, "\n", NIL); Printf(df->code, "scheme_signal_error(\"No matching function for overloaded '%s'\");\n", iname); Printv(df->code, "}\n", NIL); Wrapper_print(df, f_wrappers); 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); DelWrapper(df); Delete(dispatch); Delete(dname); } } Delete(proc_name); Delete(source); Delete(target); Delete(arg); Delete(outarg); Delete(cleanup); Delete(build); DelWrapper(f); return SWIG_OK; } /* ------------------------------------------------------------ * variableWrapper() * * Create a link to a C variable. * This creates a single function _wrap_swig_var_varname(). * This function takes a single optional argument. If supplied, it means * we are setting this variable to some value. If omitted, it means we are * simply evaluating this variable. Either way, we return the variables * value. * ------------------------------------------------------------ */ virtual int variableWrapper(Node *n) { char *name = GetChar(n, "name"); char *iname = GetChar(n, "sym:name"); SwigType *t = Getattr(n, "type"); String *proc_name = NewString(""); String *tm; String *tm2 = NewString("");; String *argnum = NewString("0"); String *arg = NewString("argv[0]"); Wrapper *f; if (!addSymbol(iname, n)) return SWIG_ERROR; f = NewWrapper(); // evaluation function names String *var_name = Swig_name_wrapper(iname); // Build the name for scheme. Printv(proc_name, iname, NIL); Replaceall(proc_name, "_", "-"); Setattr(n, "wrap:name", proc_name); if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) { Printf(f->def, "static Scheme_Object *%s(int argc, Scheme_Object** argv) {\n", var_name); Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL); Wrapper_add_local(f, "swig_result", "Scheme_Object *swig_result"); if (!GetFlag(n, "feature:immutable")) { /* Check for a setting of the variable value */ Printf(f->code, "if (argc) {\n"); if ((tm = Swig_typemap_lookup("varin", n, name, 0))) { Replaceall(tm, "$source", "argv[0]"); Replaceall(tm, "$target", name); Replaceall(tm, "$input", "argv[0]"); /* Printv(f->code, tm, "\n",NIL); */ emit_action_code(n, f->code, tm); } else { throw_unhandled_mzscheme_type_error(t); } Printf(f->code, "}\n"); } // Now return the value of the variable (regardless // of evaluating or setting) if ((tm = Swig_typemap_lookup("varout", n, name, 0))) { Replaceall(tm, "$source", name); Replaceall(tm, "$target", "swig_result"); Replaceall(tm, "$result", "swig_result"); /* Printf (f->code, "%s\n", tm); */ emit_action_code(n, f->code, tm); } else { throw_unhandled_mzscheme_type_error(t); } Printf(f->code, "\nreturn swig_result;\n"); Printf(f->code, "#undef FUNC_NAME\n"); Printf(f->code, "}\n"); Wrapper_print(f, f_wrappers); // Now add symbol to the MzScheme interpreter Printv(init_func_def, "scheme_add_global(\"", proc_name, "\", scheme_make_prim_w_arity(", var_name, ", \"", proc_name, "\", ", "0", ", ", "1", "), menv);\n", NIL); } else { Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported variable type %s (ignored).\n", SwigType_str(t, 0)); } Delete(var_name); Delete(proc_name); Delete(argnum); Delete(arg); Delete(tm2); DelWrapper(f); return SWIG_OK; } /* ------------------------------------------------------------ * constantWrapper() * ------------------------------------------------------------ */ virtual int constantWrapper(Node *n) { char *name = GetChar(n, "name"); char *iname = GetChar(n, "sym:name"); SwigType *type = Getattr(n, "type"); String *value = Getattr(n, "value"); String *var_name = NewString(""); String *proc_name = NewString(""); String *rvalue = NewString(""); String *temp = NewString(""); String *tm; // Make a static variable; Printf(var_name, "_wrap_const_%s", Swig_name_mangle(Getattr(n, "sym:name"))); // Build the name for scheme. Printv(proc_name, iname, NIL); Replaceall(proc_name, "_", "-"); if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) { Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n"); return SWIG_NOWRAP; } // See if there's a typemap Printv(rvalue, value, NIL); if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 1)) { temp = Copy(rvalue); Clear(rvalue); Printv(rvalue, "\"", temp, "\"", NIL); } if ((SwigType_type(type) == T_CHAR) && (is_a_pointer(type) == 0)) { Delete(temp); temp = Copy(rvalue); Clear(rvalue); Printv(rvalue, "'", temp, "'", NIL); } if ((tm = Swig_typemap_lookup("constant", n, name, 0))) { Replaceall(tm, "$source", rvalue); Replaceall(tm, "$value", rvalue); Replaceall(tm, "$target", name); Printf(f_init, "%s\n", tm); } else { // Create variable and assign it a value Printf(f_header, "static %s = ", SwigType_lstr(type, var_name)); if ((SwigType_type(type) == T_STRING)) { Printf(f_header, "\"%s\";\n", value); } else if (SwigType_type(type) == T_CHAR) { Printf(f_header, "\'%s\';\n", value); } else { Printf(f_header, "%s;\n", value); } // Now create a variable declaration { /* Hack alert: will cleanup later -- Dave */ Node *n = NewHash(); Setattr(n, "name", var_name); Setattr(n, "sym:name", iname); Setattr(n, "type", type); SetFlag(n, "feature:immutable"); variableWrapper(n); Delete(n); } } Delete(proc_name); Delete(rvalue); Delete(temp); return SWIG_OK; } virtual int destructorHandler(Node *n) { exporting_destructor = true; Language::destructorHandler(n); exporting_destructor = false; return SWIG_OK; } /* ------------------------------------------------------------ * classHandler() * ------------------------------------------------------------ */ virtual int classHandler(Node *n) { String *mangled_classname = 0; String *real_classname = 0; String *scm_structname = NewString(""); SwigType *ctype_ptr = NewStringf("p.%s", Getattr(n, "classtype")); SwigType *t = NewStringf("p.%s", Getattr(n, "name")); swigtype_ptr = SwigType_manglestr(t); Delete(t); cls_swigtype = SwigType_manglestr(Getattr(n, "name")); fieldnames_tab = NewString(""); convert_tab = NewString(""); convert_proto_tab = NewString(""); struct_name = Getattr(n, "sym:name"); mangled_struct_name = Swig_name_mangle(Getattr(n, "sym:name")); Printv(scm_structname, struct_name, NIL); Replaceall(scm_structname, "_", "-"); real_classname = Getattr(n, "name"); mangled_classname = Swig_name_mangle(real_classname); Printv(fieldnames_tab, "static const char *_swig_struct_", cls_swigtype, "_field_names[] = { \n", NIL); Printv(convert_proto_tab, "static Scheme_Object *_swig_convert_struct_", cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ");\n", NIL); Printv(convert_tab, "static Scheme_Object *_swig_convert_struct_", cls_swigtype, "(", SwigType_str(ctype_ptr, "ptr"), ")\n {\n", NIL); Printv(convert_tab, tab4, "Scheme_Object *obj;\n", tab4, "Scheme_Object *fields[_swig_struct_", cls_swigtype, "_field_names_cnt];\n", tab4, "int i = 0;\n\n", NIL); /* Generate normal wrappers */ Language::classHandler(n); Printv(convert_tab, tab4, "obj = scheme_make_struct_instance(", "_swig_struct_type_", cls_swigtype, ", i, fields);\n", NIL); Printv(convert_tab, tab4, "return obj;\n}\n\n", NIL); Printv(fieldnames_tab, "};\n", NIL); Printv(f_header, "static Scheme_Object *_swig_struct_type_", cls_swigtype, ";\n", NIL); Printv(f_header, fieldnames_tab, NIL); Printv(f_header, "#define _swig_struct_", cls_swigtype, "_field_names_cnt (sizeof(_swig_struct_", cls_swigtype, "_field_names)/sizeof(char*))\n", NIL); Printv(f_header, convert_proto_tab, NIL); Printv(f_wrappers, convert_tab, NIL); Printv(init_func_def, "_swig_struct_type_", cls_swigtype, " = SWIG_MzScheme_new_scheme_struct(menv, \"", scm_structname, "\", ", "_swig_struct_", cls_swigtype, "_field_names_cnt,", "(char**) _swig_struct_", cls_swigtype, "_field_names);\n", NIL); Delete(mangled_classname); Delete(swigtype_ptr); swigtype_ptr = 0; Delete(fieldnames_tab); Delete(convert_tab); Delete(ctype_ptr); Delete(convert_proto_tab); struct_name = 0; mangled_struct_name = 0; Delete(cls_swigtype); cls_swigtype = 0; return SWIG_OK; } /* ------------------------------------------------------------ * membervariableHandler() * ------------------------------------------------------------ */ virtual int membervariableHandler(Node *n) { Language::membervariableHandler(n); if (!is_smart_pointer()) { String *symname = Getattr(n, "sym:name"); String *name = Getattr(n, "name"); SwigType *type = Getattr(n, "type"); String *swigtype = SwigType_manglestr(Getattr(n, "type")); String *tm = 0; String *access_mem = NewString(""); SwigType *ctype_ptr = NewStringf("p.%s", Getattr(n, "type")); Printv(fieldnames_tab, tab4, "\"", symname, "\",\n", NIL); Printv(access_mem, "(ptr)->", name, NIL); if ((SwigType_type(type) == T_USER) && (!is_a_pointer(type))) { Printv(convert_tab, tab4, "fields[i++] = ", NIL); Printv(convert_tab, "_swig_convert_struct_", swigtype, "((", SwigType_str(ctype_ptr, ""), ")&((ptr)->", name, "));\n", NIL); } else if ((tm = Swig_typemap_lookup("varout", n, access_mem, 0))) { Replaceall(tm, "$result", "fields[i++]"); Printv(convert_tab, tm, "\n", NIL); } else Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number, "Unsupported member variable type %s (ignored).\n", SwigType_str(type, 0)); Delete(access_mem); } return SWIG_OK; } /* ------------------------------------------------------------ * validIdentifer() * ------------------------------------------------------------ */ virtual int validIdentifier(String *s) { char *c = Char(s); /* Check whether we have an R5RS identifier. */ /* --> * | */ /* --> | */ if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%') || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') || (*c == '^') || (*c == '_') || (*c == '~'))) { /* --> + | - | ... */ if ((strcmp(c, "+") == 0) || strcmp(c, "-") == 0 || strcmp(c, "...") == 0) return 1; else return 0; } /* --> | | */ while (*c) { if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%') || (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':') || (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?') || (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+') || (*c == '-') || (*c == '.') || (*c == '@'))) return 0; c++; } return 1; } String *runtimeCode() { String *s = Swig_include_sys("mzrun.swg"); if (!s) { Printf(stderr, "*** Unable to open 'mzrun.swg'\n"); s = NewString(""); } return s; } String *defaultExternalRuntimeFilename() { return NewString("swigmzrun.h"); } }; /* ----------------------------------------------------------------------------- * swig_mzscheme() - Instantiate module * ----------------------------------------------------------------------------- */ static Language *new_swig_mzscheme() { return new MZSCHEME(); } extern "C" Language *swig_mzscheme(void) { return new_swig_mzscheme(); }