mirror of https://github.com/swig/swig
815 lines
24 KiB
C++
815 lines
24 KiB
C++
/******************************************************************************
|
|
* Simplified Wrapper and Interface Generator (SWIG)
|
|
*
|
|
* Author : David Beazley
|
|
*
|
|
* Department of Computer Science
|
|
* University of Chicago
|
|
* 1100 E 58th Street
|
|
* Chicago, IL 60637
|
|
* beazley@cs.uchicago.edu
|
|
*
|
|
* Please read the file LICENSE for the copyright and terms by which SWIG
|
|
* can be used and distributed.
|
|
*****************************************************************************/
|
|
|
|
char cvsroot_mzscheme_cxx[] = "$Header$";
|
|
|
|
/***********************************************************************
|
|
* $Header$
|
|
*
|
|
* mzscheme.cxx
|
|
*
|
|
* Definitions for adding functions to Mzscheme 101
|
|
***********************************************************************/
|
|
|
|
#include "swigmod.h"
|
|
|
|
#include <ctype.h>
|
|
|
|
static const char *usage = (char*)"\
|
|
Mzscheme Options (available with -mzscheme)\n\
|
|
-prefix <name> - Set a prefix <name> 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";
|
|
|
|
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;
|
|
static String *module=0;
|
|
static char *mzscheme_path=(char*)"mzscheme";
|
|
static String *init_func_def = 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);
|
|
}
|
|
}
|
|
}
|
|
|
|
// 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_runtime = NewFile(outfile,"w");
|
|
if (!f_runtime) {
|
|
Printf(stderr,"*** Can't open '%s'\n", outfile);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
f_init = NewString("");
|
|
f_header = NewString("");
|
|
f_wrappers = NewString("");
|
|
|
|
/* Register file targets with the SWIG file handler */
|
|
Swig_register_filebyname("header",f_header);
|
|
Swig_register_filebyname("wrapper",f_wrappers);
|
|
Swig_register_filebyname("runtime",f_runtime);
|
|
|
|
init_func_def = NewString("");
|
|
Swig_register_filebyname("init",init_func_def);
|
|
|
|
Printf(f_runtime, "/* -*- buffer-read-only: t -*- vi: set ro: */\n");
|
|
Swig_banner (f_runtime);
|
|
|
|
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");
|
|
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_header,f_runtime);
|
|
Dump(f_wrappers,f_runtime);
|
|
Wrapper_pretty_print(f_init,f_runtime);
|
|
Delete(f_header);
|
|
Delete(f_wrappers);
|
|
Delete(f_init);
|
|
Close(f_runtime);
|
|
Delete(f_runtime);
|
|
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;
|
|
|
|
// 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)) 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);
|
|
|
|
// Declare return variable and arguments
|
|
// number of parameters
|
|
// they are called arg0, arg1, ...
|
|
// the return value is called result
|
|
|
|
emit_args(d, 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);
|
|
|
|
// adds local variables
|
|
Wrapper_add_local(f, "lenv", "int lenv = 1");
|
|
Wrapper_add_local(f, "values", "Scheme_Object *values[MAXVALUES]");
|
|
|
|
// 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
|
|
|
|
emit_action(n,f);
|
|
|
|
// Now have return value, figure out what to do with it.
|
|
|
|
if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) {
|
|
Replaceall(tm,"$source","result");
|
|
Replaceall(tm,"$target","values[0]");
|
|
Replaceall(tm,"$result","values[0]");
|
|
if (Getattr(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);
|
|
}
|
|
|
|
// 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 (Getattr(n,"feature:new")) {
|
|
if ((tm = Swig_typemap_lookup_new("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_new("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);
|
|
|
|
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("");
|
|
char var_name[256];
|
|
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
|
|
|
|
strcpy(var_name, Char(Swig_name_wrapper(iname)));
|
|
|
|
// Build the name for scheme.
|
|
Printv(proc_name, iname,NIL);
|
|
Replaceall(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 (!Getattr(n,"feature:immutable")) {
|
|
/* Check for a setting of the variable value */
|
|
Printf (f->code, "if (argc) {\n");
|
|
if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
|
|
Replaceall(tm,"$source","argv[0]");
|
|
Replaceall(tm,"$target",name);
|
|
Replaceall(tm,"$input","argv[0]");
|
|
Printv(f->code, tm, "\n",NIL);
|
|
}
|
|
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_new("varout",n,name,0))) {
|
|
Replaceall(tm,"$source",name);
|
|
Replaceall(tm,"$target","swig_result");
|
|
Replaceall(tm,"$result","swig_result");
|
|
Printf (f->code, "%s\n", 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(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_new("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);
|
|
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_new("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.*/
|
|
/* <identifier> --> <initial> <subsequent>* | <peculiar identifier> */
|
|
/* <initial> --> <letter> | <special initial> */
|
|
if (!(isalpha(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|
|
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|
|
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|
|
|| (*c == '^') || (*c == '_') || (*c == '~'))) {
|
|
/* <peculiar identifier> --> + | - | ... */
|
|
if ((strcmp(c, "+") == 0)
|
|
|| strcmp(c, "-") == 0
|
|
|| strcmp(c, "...") == 0) return 1;
|
|
else return 0;
|
|
}
|
|
/* <subsequent> --> <initial> | <digit> | <special subsequent> */
|
|
while (*c) {
|
|
if (!(isalnum(*c) || (*c == '!') || (*c == '$') || (*c == '%')
|
|
|| (*c == '&') || (*c == '*') || (*c == '/') || (*c == ':')
|
|
|| (*c == '<') || (*c == '=') || (*c == '>') || (*c == '?')
|
|
|| (*c == '^') || (*c == '_') || (*c == '~') || (*c == '+')
|
|
|| (*c == '-') || (*c == '.') || (*c == '@'))) return 0;
|
|
c++;
|
|
}
|
|
return 1;
|
|
}
|
|
};
|
|
|
|
/* -----------------------------------------------------------------------------
|
|
* swig_mzscheme() - Instantiate module
|
|
* ----------------------------------------------------------------------------- */
|
|
|
|
static Language * new_swig_mzscheme() {
|
|
return new MZSCHEME();
|
|
}
|
|
extern "C" Language * swig_mzscheme(void) {
|
|
return new_swig_mzscheme();
|
|
}
|
|
|
|
|