| |
| /* ----------------------------------------------------------------------------- |
| * This file is part of SWIG, which is licensed as a whole under version 3 |
| * (or any later version) of the GNU General Public License. Some additional |
| * terms also apply to certain portions of SWIG. The full details of the SWIG |
| * license and copyrights can be found in the LICENSE and COPYRIGHT files |
| * included with the SWIG source code as distributed by the SWIG developers |
| * and at http://www.swig.org/legal.html. |
| * |
| * r.cxx |
| * |
| * R language module for SWIG. |
| * ----------------------------------------------------------------------------- */ |
| |
| #include "swigmod.h" |
| #include "cparse.h" |
| |
| static String* replaceInitialDash(const String *name) |
| { |
| String *retval; |
| if (!Strncmp(name, "_", 1)) { |
| retval = Copy(name); |
| Insert(retval, 0, "s"); |
| } else { |
| retval = Copy(name); |
| } |
| return retval; |
| } |
| |
| static String * getRTypeName(SwigType *t, int *outCount = NULL) { |
| String *b = SwigType_base(t); |
| List *els = SwigType_split(t); |
| int count = 0; |
| int i; |
| |
| if(Strncmp(b, "struct ", 7) == 0) |
| Replace(b, "struct ", "", DOH_REPLACE_FIRST); |
| |
| for(i = 0; i < Len(els); i++) { |
| String *el = Getitem(els, i); |
| if(Strcmp(el, "p.") == 0 || Strncmp(el, "a(", 2) == 0) { |
| count++; |
| Append(b, "Ref"); |
| } |
| } |
| if(outCount) |
| *outCount = count; |
| |
| String *tmp = NewString(""); |
| char *retName = Char(SwigType_manglestr(t)); |
| Insert(tmp, 0, retName); |
| return tmp; |
| |
| } |
| |
| /* -------------------------------------------------------------- |
| * Tries to get the resolved name, with options of adding |
| * or removing a layer of references. Take care not |
| * to request both |
| * --------------------------------------------------------------*/ |
| |
| static String *getRClassName(String *retType, int deRef=0, int upRef=0) { |
| SwigType *resolved = SwigType_typedef_resolve_all(retType); |
| int ispointer = SwigType_ispointer(resolved); |
| int isreference = SwigType_isreference(resolved); |
| if (upRef) { |
| SwigType_add_pointer(resolved); |
| } |
| if (deRef) { |
| if (ispointer) { |
| SwigType_del_pointer(resolved); |
| } |
| if (isreference) { |
| SwigType_del_reference(resolved); |
| } |
| } |
| String *tmp = NewString(""); |
| Insert(tmp, 0, Char(SwigType_manglestr(resolved))); |
| return(tmp); |
| } |
| |
| /* -------------------------------------------------------------- |
| * Tries to get the name of the R class corresponding to the given type |
| * e.g. struct A * is ARef, struct A** is ARefRef. |
| * Now handles arrays, i.e. struct A[2] |
| * --------------------------------------------------------------*/ |
| |
| |
| static String * getRClassNameCopyStruct(String *retType, int addRef) { |
| String *tmp = NewString(""); |
| |
| List *l = SwigType_split(retType); |
| int n = Len(l); |
| if(!l || n == 0) { |
| #ifdef R_SWIG_VERBOSE |
| Printf(stdout, "SwigType_split return an empty list for %s\n", retType); |
| #endif |
| return(tmp); |
| } |
| |
| |
| String *el = Getitem(l, n-1); |
| char *ptr = Char(el); |
| if(strncmp(ptr, "struct ", 7) == 0) |
| ptr += 7; |
| |
| Printf(tmp, "%s", ptr); |
| |
| if(addRef) { |
| for(int i = 0; i < n; i++) { |
| if(Strcmp(Getitem(l, i), "p.") == 0 || |
| Strncmp(Getitem(l, i), "a(", 2) == 0) |
| Printf(tmp, "Ref"); |
| } |
| } |
| |
| return tmp; |
| } |
| |
| |
| /* ------------------------------------------------------------- |
| * Write the elements of a list to the File*, one element per line. |
| * If quote is true, surround the element with "element". |
| * This takes care of inserting a tab in front of each line and also |
| * a comma after each element, except the last one. |
| * --------------------------------------------------------------*/ |
| |
| |
| static void writeListByLine(List *l, File *out, bool quote = 0) { |
| int i, n = Len(l); |
| for(i = 0; i < n; i++) |
| Printf(out, "%s%s%s%s%s\n", tab8, |
| quote ? "\"" :"", |
| Getitem(l, i), |
| quote ? "\"" :"", i < n-1 ? "," : ""); |
| } |
| |
| |
| static const char *usage = "\ |
| R Options (available with -r)\n\ |
| -copystruct - Emit R code to copy C structs (on by default)\n\ |
| -debug - Output debug\n\ |
| -dll <name> - Name of the DLL (without the .dll or .so suffix).\n\ |
| Default is the module name.\n\ |
| -gc - Aggressive garbage collection\n\ |
| -memoryprof - Add memory profile\n\ |
| -namespace - Output NAMESPACE file\n\ |
| -no-init-code - Turn off the generation of the R_init_<pkgname> code\n\ |
| (registration information still generated)\n\ |
| -package <name> - Package name for the PACKAGE argument of the R .Call()\n\ |
| invocations. Default is the module name.\n\ |
| "; |
| |
| |
| |
| /* ------------------------------------------------------------- |
| * Display the help for this module on the screen/console. |
| * --------------------------------------------------------------*/ |
| |
| static void showUsage() { |
| fputs(usage, stdout); |
| } |
| |
| static bool expandTypedef(SwigType *t) { |
| if (SwigType_isenum(t)) return false; |
| String *prefix = SwigType_prefix(t); |
| if (Strncmp(prefix, "f", 1)) return false; |
| if (Strncmp(prefix, "p.f", 3)) return false; |
| return true; |
| } |
| |
| |
| /* ------------------------------------------------------------- |
| * Determine whether we should add a .copy argument to the S function |
| * that wraps/interfaces to the routine that returns the given type. |
| * --------------------------------------------------------------*/ |
| |
| static int addCopyParameter(SwigType *type) { |
| int ok = 0; |
| ok = Strncmp(type, "struct ", 7) == 0 || Strncmp(type, "p.struct ", 9) == 0; |
| if(!ok) { |
| ok = Strncmp(type, "p.", 2); |
| } |
| |
| return(ok); |
| } |
| |
| static void replaceRClass(String *tm, SwigType *type) { |
| String *tmp = getRClassName(type, 0, 0); |
| String *tmp_base = getRClassName(type, 1, 0); |
| String *tmp_ref = getRClassName(type, 0, 1); |
| Replaceall(tm, "$R_class", tmp); |
| Replaceall(tm, "$*R_class", tmp_base); |
| Replaceall(tm, "$&R_class", tmp_ref); |
| Delete(tmp); Delete(tmp_base); Delete(tmp_ref); |
| } |
| |
| class R : public Language { |
| public: |
| R(); |
| void registerClass(Node *n); |
| void main(int argc, char *argv[]); |
| int top(Node *n); |
| |
| void dispatchFunction(Node *n); |
| int functionWrapper(Node *n); |
| int constantWrapper(Node *n); |
| int variableWrapper(Node *n); |
| |
| int classDeclaration(Node *n); |
| int enumDeclaration(Node *n); |
| String *enumValue(Node *n); |
| virtual int enumvalueDeclaration(Node *n); |
| int membervariableHandler(Node *n); |
| |
| int typedefHandler(Node *n); |
| |
| static List *Swig_overload_rank(Node *n, |
| bool script_lang_wrapping); |
| |
| int memberfunctionHandler(Node *n) { |
| if (debugMode) |
| Printf(stdout, "<memberfunctionHandler> %s %s\n", |
| Getattr(n, "name"), |
| Getattr(n, "type")); |
| member_name = Getattr(n, "sym:name"); |
| processing_class_member_function = 1; |
| int status = Language::memberfunctionHandler(n); |
| processing_class_member_function = 0; |
| return status; |
| } |
| |
| /* Grab the name of the current class being processed so that we can |
| deal with members of that class. */ |
| int classHandler(Node *n){ |
| if(!ClassMemberTable) |
| ClassMemberTable = NewHash(); |
| |
| class_name = Getattr(n, "name"); |
| int status = Language::classHandler(n); |
| |
| class_name = NULL; |
| return status; |
| } |
| |
| // Not used: |
| String *runtimeCode(); |
| |
| protected: |
| int addRegistrationRoutine(String *rname, int nargs); |
| int outputRegistrationRoutines(File *out); |
| |
| int outputCommandLineArguments(File *out); |
| int generateCopyRoutines(Node *n); |
| int DumpCode(Node *n); |
| |
| int OutputMemberReferenceMethod(String *className, int isSet, List *memberList, List *nameList, List *typeList, File *out); |
| int defineArrayAccessors(SwigType *type); |
| |
| void addNamespaceFunction(String *name) { |
| if(!namespaceFunctions) |
| namespaceFunctions = NewList(); |
| Append(namespaceFunctions, name); |
| } |
| |
| void addNamespaceMethod(String *name) { |
| if(!namespaceMethods) |
| namespaceMethods = NewList(); |
| Append(namespaceMethods, name); |
| } |
| |
| String* processType(SwigType *t, Node *n, int *nargs = NULL); |
| String *createFunctionPointerHandler(SwigType *t, Node *n, int *nargs); |
| int addFunctionPointerProxy(String *name, Node *n, SwigType *t, String *s_paramTypes) { |
| /*XXX Do we need to put the t in there to get the return type later. */ |
| if(!functionPointerProxyTable) |
| functionPointerProxyTable = NewHash(); |
| |
| Setattr(functionPointerProxyTable, name, n); |
| |
| Setattr(SClassDefs, name, name); |
| Printv(s_classes, "setClass('", |
| name, |
| "',\n", tab8, |
| "prototype = list(parameterTypes = c(", s_paramTypes, "),\n", |
| tab8, tab8, tab8, |
| "returnType = '", SwigType_manglestr(t), "'),\n", tab8, |
| "contains = 'CRoutinePointer')\n\n##\n", NIL); |
| |
| return SWIG_OK; |
| } |
| |
| |
| void addSMethodInfo(String *name, |
| String *argType, int nargs); |
| // Simple initialization such as constant strings that can be reused. |
| void init(); |
| |
| |
| void addAccessor(String *memberName, Wrapper *f, |
| String *name, String *methodSetGet); |
| |
| static int getFunctionPointerNumArgs(Node *n, SwigType *tt); |
| |
| // filtering of class member lists by function type. Used in constructing accessors |
| // are we allowed to use stl style functors to customise this? |
| List* filterMemberList(List *class_member_function_types, List *class_member_other, String *R_MEMBER, bool equal); |
| |
| protected: |
| bool copyStruct; |
| bool memoryProfile; |
| bool aggressiveGc; |
| |
| // Strings into which we cumulate the generated code that is to be written |
| //vto the files. |
| String *enum_values; |
| String *enum_def_calls; |
| String *sfile; |
| String *f_init; |
| String *s_classes; |
| String *f_begin; |
| String *f_runtime; |
| String *f_wrapper; |
| String *s_header; |
| String *f_wrappers; |
| String *s_init; |
| String *s_init_routine; |
| String *s_namespace; |
| |
| // State variables that carry information across calls to functionWrapper() |
| // from member accessors and class declarations. |
| String *opaqueClassDeclaration; |
| int processing_variable; |
| int processing_member_access_function; |
| String *member_name; |
| String *class_name; |
| |
| String *R_MEMBER_NORMAL; |
| String *R_MEMBER_SET; |
| String *R_MEMBER_GET; |
| |
| int processing_class_member_function; |
| // Spread out the lists so that they are simpler to process |
| // by storing the type of the method (i.e. set, get or nothing) |
| // and having separate lists for name, membername and wrapper |
| List *class_member_function_types; |
| List *class_member_function_names; |
| List *class_member_function_membernames; |
| List *class_member_function_wrappernames; |
| /* */ |
| Hash *ClassMemberTable; |
| Hash *ClassMethodsTable; |
| Hash *SClassDefs; |
| Hash *SMethodInfo; |
| |
| // Information about routines that are generated and to be registered with |
| // R for dynamic lookup. |
| Hash *registrationTable; |
| Hash *functionPointerProxyTable; |
| |
| List *namespaceFunctions; |
| List *namespaceMethods; |
| List *namespaceClasses; // Probably can do this from ClassMemberTable. |
| |
| |
| // Store a copy of the command line. |
| // Need only keep a string that has it formatted. |
| char **Argv; |
| int Argc; |
| bool inCPlusMode; |
| |
| // State variables that we remember from the command line settings |
| // potentially that govern the code we generate. |
| String *DllName; |
| String *Rpackage; |
| bool noInitializationCode; |
| bool outputNamespaceInfo; |
| |
| String *UnProtectWrapupCode; |
| |
| // Static members |
| static bool debugMode; |
| }; |
| |
| R::R() : |
| copyStruct(false), |
| memoryProfile(false), |
| aggressiveGc(false), |
| enum_values(0), |
| enum_def_calls(0), |
| sfile(0), |
| f_init(0), |
| s_classes(0), |
| f_begin(0), |
| f_runtime(0), |
| f_wrapper(0), |
| s_header(0), |
| f_wrappers(0), |
| s_init(0), |
| s_init_routine(0), |
| s_namespace(0), |
| opaqueClassDeclaration(0), |
| processing_variable(0), |
| processing_member_access_function(0), |
| member_name(0), |
| class_name(0), |
| R_MEMBER_NORMAL(NewString("normal")), |
| R_MEMBER_SET(NewString("set")), |
| R_MEMBER_GET(NewString("get")), |
| processing_class_member_function(0), |
| class_member_function_types(0), |
| class_member_function_names(0), |
| class_member_function_membernames(0), |
| class_member_function_wrappernames(0), |
| ClassMemberTable(0), |
| ClassMethodsTable(0), |
| SClassDefs(0), |
| SMethodInfo(0), |
| registrationTable(0), |
| functionPointerProxyTable(0), |
| namespaceFunctions(0), |
| namespaceMethods(0), |
| namespaceClasses(0), |
| Argv(0), |
| Argc(0), |
| inCPlusMode(false), |
| DllName(0), |
| Rpackage(0), |
| noInitializationCode(false), |
| outputNamespaceInfo(false), |
| UnProtectWrapupCode(0) { |
| } |
| |
| bool R::debugMode = false; |
| |
| int R::getFunctionPointerNumArgs(Node *n, SwigType *tt) { |
| (void) tt; |
| n = Getattr(n, "type"); |
| if (debugMode) |
| Printf(stdout, "type: %s\n", n); |
| |
| ParmList *parms = Getattr(n, "parms"); |
| if (debugMode) |
| Printf(stdout, "parms = %p\n", parms); |
| return ParmList_len(parms); |
| } |
| |
| |
| void R::addSMethodInfo(String *name, String *argType, int nargs) { |
| (void) argType; |
| |
| if(!SMethodInfo) |
| SMethodInfo = NewHash(); |
| if (debugMode) |
| Printf(stdout, "[addMethodInfo] %s\n", name); |
| |
| Hash *tb = Getattr(SMethodInfo, name); |
| |
| if(!tb) { |
| tb = NewHash(); |
| Setattr(SMethodInfo, name, tb); |
| } |
| |
| String *str = Getattr(tb, "max"); |
| int max = -1; |
| if(str) |
| max = atoi(Char(str)); |
| if(max < nargs) { |
| if(str) Delete(str); |
| str = NewStringf("%d", max); |
| Setattr(tb, "max", str); |
| } |
| } |
| |
| /* ---------------------------------------- |
| * Returns the name of the new routine. |
| * ------------------------------------------ */ |
| |
| String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { |
| String *funName = SwigType_manglestr(t); |
| |
| /* See if we have already processed this one. */ |
| if(functionPointerProxyTable && Getattr(functionPointerProxyTable, funName)) |
| return funName; |
| |
| if (debugMode) |
| Printf(stdout, "<createFunctionPointerHandler> Defining %s\n", t); |
| |
| SwigType *rettype = Copy(Getattr(n, "type")); |
| SwigType *funcparams = SwigType_functionpointer_decompose(rettype); |
| String *rtype = SwigType_str(rettype, 0); |
| |
| // ParmList *parms = Getattr(n, "parms"); |
| // memory leak |
| ParmList *parms = SwigType_function_parms(SwigType_del_pointer(Copy(t)), n); |
| |
| |
| if (debugMode) { |
| Printf(stdout, "Type: %s\n", t); |
| Printf(stdout, "Return type: %s\n", SwigType_base(t)); |
| } |
| |
| bool isVoidType = Strcmp(rettype, "void") == 0; |
| if (debugMode) |
| Printf(stdout, "%s is void ? %s (%s)\n", funName, isVoidType ? "yes" : "no", rettype); |
| |
| Wrapper *f = NewWrapper(); |
| |
| /* Go through argument list, attach lnames for arguments */ |
| int i = 0; |
| Parm *p = parms; |
| for (i = 0; p; p = nextSibling(p), ++i) { |
| String *arg = Getattr(p, "name"); |
| String *lname; |
| if (!arg && Cmp(Getattr(p, "type"), "void")) { |
| lname = NewStringf("arg%d", i+1); |
| Setattr(p, "name", lname); |
| } else |
| lname = arg; |
| |
| Setattr(p, "lname", lname); |
| } |
| |
| Swig_typemap_attach_parms("out", parms, f); |
| Swig_typemap_attach_parms("scoerceout", parms, f); |
| Swig_typemap_attach_parms("scheck", parms, f); |
| |
| Printf(f->def, "%s %s(", rtype, funName); |
| |
| emit_parameter_variables(parms, f); |
| emit_return_variable(n, rettype, f); |
| // emit_attach_parmmaps(parms,f); |
| |
| /* Using weird name and struct to avoid potential conflicts. */ |
| Wrapper_add_local(f, "r_swig_cb_data", "RCallbackFunctionData *r_swig_cb_data = R_SWIG_getCallbackFunctionData()"); |
| String *lvar = NewString("r_swig_cb_data"); |
| |
| Wrapper_add_local(f, "r_tmp", "SEXP r_tmp"); // for use in converting arguments to R objects for call. |
| Wrapper_add_local(f, "r_nprotect", "int r_nprotect = 0"); // for use in converting arguments to R objects for call. |
| Wrapper_add_local(f, "r_vmax", "char * r_vmax= 0"); // for use in converting arguments to R objects for call. |
| |
| // Add local for error code in return value. This is not in emit_return_variable because that assumes an out typemap |
| // whereas the type makes are reverse |
| Wrapper_add_local(f, "ecode", "int ecode = 0"); |
| |
| p = parms; |
| int nargs = ParmList_len(parms); |
| if(numArgs) { |
| *numArgs = nargs; |
| if (debugMode) |
| Printf(stdout, "Setting number of parameters to %d\n", *numArgs); |
| } |
| String *setExprElements = NewString(""); |
| |
| String *s_paramTypes = NewString(""); |
| for(i = 0; p; i++) { |
| SwigType *tt = Getattr(p, "type"); |
| SwigType *name = Getattr(p, "name"); |
| SwigType *swig_parm_name = NewStringf("swigarg_%s", name); |
| String *tm = Getattr(p, "tmap:out"); |
| bool isVoidParm = Strcmp(tt, "void") == 0; |
| if (isVoidParm) |
| Printf(f->def, "%s", SwigType_str(tt, 0)); |
| else |
| Printf(f->def, "%s %s", SwigType_str(tt, 0), swig_parm_name); |
| if (tm) { |
| String *lstr = SwigType_lstr(tt, 0); |
| if (SwigType_isreference(tt) || SwigType_isrvalue_reference(tt)) { |
| Printf(f->code, "%s = (%s) &%s;\n", Getattr(p, "lname"), lstr, swig_parm_name); |
| } else if (!isVoidParm) { |
| Printf(f->code, "%s = (%s) %s;\n", Getattr(p, "lname"), lstr, swig_parm_name); |
| } |
| Replaceall(tm, "$1", name); |
| Replaceall(tm, "$result", "r_tmp"); |
| if (debugMode) { |
| Printf(stdout, "Calling Replace A: %s\n", Getattr(p,"type")); |
| } |
| replaceRClass(tm, Getattr(p,"type")); |
| Replaceall(tm,"$owner", "0"); |
| Delete(lstr); |
| } |
| |
| Printf(setExprElements, "%s\n", tm); |
| Printf(setExprElements, "SETCAR(r_swig_cb_data->el, %s);\n", "r_tmp"); |
| Printf(setExprElements, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n"); |
| |
| Printf(s_paramTypes, "'%s'", SwigType_manglestr(tt)); |
| |
| |
| p = nextSibling(p); |
| if(p) { |
| Printf(f->def, ", "); |
| Printf(s_paramTypes, ", "); |
| } |
| } |
| |
| Printf(f->def, ") {\n"); |
| |
| Printf(f->code, "Rf_protect(%s->expr = Rf_allocVector(LANGSXP, %d));\n", lvar, nargs + 1); |
| Printf(f->code, "r_nprotect++;\n"); |
| Printf(f->code, "r_swig_cb_data->el = r_swig_cb_data->expr;\n\n"); |
| |
| Printf(f->code, "SETCAR(r_swig_cb_data->el, r_swig_cb_data->fun);\n"); |
| Printf(f->code, "r_swig_cb_data->el = CDR(r_swig_cb_data->el);\n\n"); |
| |
| Printf(f->code, "%s\n\n", setExprElements); |
| |
| Printv(f->code, "r_swig_cb_data->retValue = R_tryEval(", |
| "r_swig_cb_data->expr,", |
| " R_GlobalEnv,", |
| " &r_swig_cb_data->errorOccurred", |
| ");\n", |
| NIL); |
| |
| Printv(f->code, "\n", |
| "if(r_swig_cb_data->errorOccurred) {\n", |
| "R_SWIG_popCallbackFunctionData(1);\n", |
| "Rf_error(\"error in calling R function as a function pointer (", |
| funName, |
| ")\");\n", |
| "}\n", |
| NIL); |
| |
| |
| |
| if(!isVoidType) { |
| /* Need to deal with the return type of the function pointer, not the function pointer itself. |
| So build a new node that has the relevant pieces. |
| XXX Have to be a little more clever so that we can deal with struct A * - the * is getting lost. |
| Is this still true? If so, will a SwigType_push() solve things? |
| */ |
| Parm *bbase = NewParmNode(rettype, n); |
| String *returnTM = Swig_typemap_lookup("in", bbase, Swig_cresult_name(), f); |
| if(returnTM) { |
| String *tm = returnTM; |
| Replaceall(tm,"$input", "r_swig_cb_data->retValue"); |
| Replaceall(tm,"$target", Swig_cresult_name()); |
| replaceRClass(tm, rettype); |
| Replaceall(tm,"$owner", "0"); |
| Replaceall(tm,"$disown","0"); |
| Printf(f->code, "%s\n", tm); |
| } |
| Delete(bbase); |
| } |
| |
| Printv(f->code, "R_SWIG_popCallbackFunctionData(1);\n", NIL); |
| Printv(f->code, "\n", UnProtectWrapupCode, NIL); |
| |
| if (SwigType_isreference(rettype)) { |
| Printv(f->code, "return *", Swig_cresult_name(), ";\n", NIL); |
| } else if (SwigType_isrvalue_reference(rettype)) { |
| Printv(f->code, "return std::move(*", Swig_cresult_name(), ");\n", NIL); |
| } else if (!isVoidType) { |
| Printv(f->code, "return ", Swig_cresult_name(), ";\n", NIL); |
| } |
| |
| Printv(f->code, "\n}\n", NIL); |
| Replaceall(f->code, "SWIG_exception_fail", "SWIG_exception_noreturn"); |
| |
| /* To coerce correctly in S, we really want to have an extra/intermediate |
| function that handles the scoerceout. |
| We need to check if any of the argument types have an entry in |
| that map. If none do, the ignore and call the function straight. |
| Otherwise, generate a marshalling function. |
| Need to be able to find it in S. Or use an entirely generic one |
| that evaluates the expressions. |
| Handle errors in the evaluation of the function by restoring |
| the stack, if there is one in use for this function (i.e. no |
| userData). |
| */ |
| |
| Wrapper_print(f, f_wrapper); |
| |
| addFunctionPointerProxy(funName, n, t, s_paramTypes); |
| Delete(s_paramTypes); |
| Delete(rtype); |
| Delete(rettype); |
| Delete(funcparams); |
| DelWrapper(f); |
| |
| return funName; |
| } |
| |
| void R::init() { |
| UnProtectWrapupCode = |
| NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect) Rf_unprotect(r_nprotect);\n\n"); |
| |
| SClassDefs = NewHash(); |
| |
| sfile = NewString(""); |
| f_init = NewString(""); |
| s_header = NewString(""); |
| f_begin = NewString(""); |
| f_runtime = NewString(""); |
| f_wrapper = NewString(""); |
| s_classes = NewString(""); |
| s_init = NewString(""); |
| s_init_routine = NewString(""); |
| enum_def_calls = NewString(""); |
| } |
| |
| |
| /* ------------------------------------------------------------- |
| * Method from Language that is called to start the entire |
| * processing off, i.e. the generation of the code. |
| * It is called after the input has been read and parsed. |
| * Here we open the output streams and generate the code. |
| * ------------------------------------------------------------- */ |
| int R::top(Node *n) { |
| String *module = Getattr(n, "name"); |
| |
| if (debugMode) { |
| Printf(stdout, "<Top> %s\n", module); |
| } |
| |
| if(!Rpackage) |
| Rpackage = Copy(module); |
| if(!DllName) |
| DllName = Copy(module); |
| |
| if(outputNamespaceInfo) { |
| s_namespace = NewString(""); |
| Swig_register_filebyname("snamespace", s_namespace); |
| Printf(s_namespace, "useDynLib(%s)\n", DllName); |
| } |
| // Register the naming functions |
| Swig_name_register("wrapper", "R_swig_%f"); |
| |
| /* Associate the different streams with names so that they can be used in %insert directives by the |
| typemap code. */ |
| Swig_register_filebyname("sinit", s_init); |
| Swig_register_filebyname("sinitroutine", s_init_routine); |
| |
| Swig_register_filebyname("begin", f_begin); |
| Swig_register_filebyname("runtime", f_runtime); |
| Swig_register_filebyname("init", f_init); |
| Swig_register_filebyname("header", s_header); |
| Swig_register_filebyname("wrapper", f_wrapper); |
| Swig_register_filebyname("s", sfile); |
| Swig_register_filebyname("sclasses", s_classes); |
| |
| Swig_banner(f_begin); |
| |
| Printf(f_runtime, "\n\n#ifndef SWIGR\n#define SWIGR\n#endif\n\n"); |
| |
| |
| Swig_banner_target_lang(s_init, "#"); |
| outputCommandLineArguments(s_init); |
| |
| Printf(f_wrapper, "#ifdef __cplusplus\n"); |
| Printf(f_wrapper, "extern \"C\" {\n"); |
| Printf(f_wrapper, "#endif\n\n"); |
| |
| Language::top(n); |
| |
| Printf(f_wrapper, "#ifdef __cplusplus\n"); |
| Printf(f_wrapper, "}\n"); |
| Printf(f_wrapper, "#endif\n"); |
| |
| String *type_table = NewString(""); |
| SwigType_emit_type_table(f_runtime,f_wrapper); |
| Delete(type_table); |
| |
| if(ClassMemberTable) { |
| //XXX OutputClassAccessInfo(ClassMemberTable, sfile); |
| Delete(ClassMemberTable); |
| ClassMemberTable = NULL; |
| } |
| |
| Printf(f_init,"}\n"); |
| if(registrationTable) |
| outputRegistrationRoutines(f_init); |
| |
| /* Now arrange to write the 2 files - .S and .c. */ |
| |
| DumpCode(n); |
| |
| Delete(sfile); |
| Delete(s_classes); |
| Delete(s_init); |
| Delete(f_wrapper); |
| Delete(f_init); |
| |
| Delete(s_header); |
| Delete(f_runtime); |
| Delete(f_begin); |
| |
| return SWIG_OK; |
| } |
| |
| |
| /* ------------------------------------------------------------- |
| * Write the generated code to the .S and the .c files. |
| * ------------------------------------------------------------- */ |
| int R::DumpCode(Node *n) { |
| String *output_filename = NewString(""); |
| |
| |
| /* The name of the file in which we will generate the S code. */ |
| Printf(output_filename, "%s%s.R", SWIG_output_directory(), Rpackage); |
| |
| #ifdef R_SWIG_VERBOSE |
| Printf(stdout, "Writing S code to %s\n", output_filename); |
| #endif |
| |
| File *scode = NewFile(output_filename, "w", SWIG_output_files()); |
| if (!scode) { |
| FileErrorDisplay(output_filename); |
| SWIG_exit(EXIT_FAILURE); |
| } |
| Delete(output_filename); |
| |
| |
| Printf(scode, "%s\n\n", s_init); |
| Printf(scode, "%s\n\n", s_classes); |
| Printf(scode, "%s\n", sfile); |
| Printf(scode, "%s\n", enum_def_calls); |
| |
| Delete(scode); |
| String *outfile = Getattr(n,"outfile"); |
| File *runtime = NewFile(outfile,"w", SWIG_output_files()); |
| if (!runtime) { |
| FileErrorDisplay(outfile); |
| SWIG_exit(EXIT_FAILURE); |
| } |
| |
| Printf(runtime, "%s", f_begin); |
| Printf(runtime, "%s\n", f_runtime); |
| Printf(runtime, "%s\n", s_header); |
| Printf(runtime, "%s\n", f_wrapper); |
| Printf(runtime, "%s\n", f_init); |
| |
| Delete(runtime); |
| |
| if(outputNamespaceInfo) { |
| output_filename = NewString(""); |
| Printf(output_filename, "%sNAMESPACE", SWIG_output_directory()); |
| File *ns = NewFile(output_filename, "w", SWIG_output_files()); |
| if (!ns) { |
| FileErrorDisplay(output_filename); |
| SWIG_exit(EXIT_FAILURE); |
| } |
| Delete(output_filename); |
| |
| Printf(ns, "%s\n", s_namespace); |
| |
| Printf(ns, "\nexport(\n"); |
| writeListByLine(namespaceFunctions, ns); |
| Printf(ns, ")\n"); |
| Printf(ns, "\nexportMethods(\n"); |
| writeListByLine(namespaceMethods, ns, 1); |
| Printf(ns, ")\n"); |
| Delete(ns); |
| Delete(s_namespace); |
| } |
| |
| return SWIG_OK; |
| } |
| |
| |
| List *R::filterMemberList(List *class_member_types, |
| List *class_member_other, |
| String *R_MEMBER, bool equal) { |
| // filters class_member_other based on whether corresponding elements of |
| // class_member_function_types are equal or notequal to R_MEMBER |
| List *CM = NewList(); |
| Iterator ftype, other; |
| |
| for (ftype = First(class_member_types), other = First(class_member_other); |
| ftype.item; |
| ftype=Next(ftype), other=Next(other)) { |
| // verbose, clean up later if the overall structure works |
| if (equal) { |
| if (ftype.item == R_MEMBER) { |
| Append(CM, other.item); |
| } |
| } else { |
| if (ftype.item != R_MEMBER) { |
| Append(CM, other.item); |
| } |
| } |
| } |
| return(CM); |
| } |
| |
| # if 0 |
| // not called |
| /* ------------------------------------------------------------- |
| * We may need to do more.... so this is left as a |
| * stub for the moment. |
| * -------------------------------------------------------------*/ |
| int R::OutputClassAccessInfo(Hash *tb, File *out) { |
| int n = OutputClassMemberTable(tb, out); |
| OutputClassMethodsTable(out); |
| return n; |
| } |
| |
| /* ------------------------------------------------------------- |
| * Currently this just writes the information collected about the |
| * different methods of the C++ classes that have been processed |
| * to the console. |
| * This will be used later to define S4 generics and methods. |
| * --------------------------------------------------------------*/ |
| |
| int R::OutputClassMethodsTable(File *) { |
| Hash *tb = ClassMethodsTable; |
| |
| if(!tb) |
| return SWIG_OK; |
| |
| List *keys = Keys(tb); |
| String *key; |
| int i, n = Len(keys); |
| if (debugMode) { |
| for(i = 0; i < n ; i++ ) { |
| key = Getitem(keys, i); |
| Printf(stdout, "%d) %s\n", i, key); |
| List *els = Getattr(tb, key); |
| int nels = Len(els); |
| Printf(stdout, "\t"); |
| for(int j = 0; j < nels; j+=2) { |
| Printf(stdout, "%s%s", Getitem(els, j), j < nels - 1 ? ", " : ""); |
| Printf(stdout, "%s\n", Getitem(els, j+1)); |
| } |
| Printf(stdout, "\n"); |
| } |
| } |
| |
| return SWIG_OK; |
| } |
| |
| |
| /* -------------------------------------------------------------- |
| * Iterate over the <class name>_set and <>_get |
| * elements and generate the $ and $<- functions |
| * that provide constrained access to the member |
| * fields in these elements. |
| |
| * tb - a hash table that is built up in functionWrapper |
| * as we process each membervalueHandler. |
| * The entries are indexed by <class name>_set and |
| * <class_name>_get. Each entry is a List *. |
| |
| * out - the stram where the code is to be written. This is the S |
| * code stream as we generate only S code here. |
| * --------------------------------------------------------------*/ |
| |
| int R::OutputClassMemberTable(Hash *tb, File *out) { |
| List *keys = Keys(tb), *el; |
| |
| String *key; |
| int i, n = Len(keys); |
| /* Loop over all the <Class>_set and <Class>_get entries in the table. */ |
| /* This function checks for names ending in _set - perhaps it should */ |
| /* use attributes of some other form, as it potentially clashes with */ |
| /* methods ending in _set */ |
| |
| if(n && outputNamespaceInfo) { |
| Printf(s_namespace, "exportClasses("); |
| } |
| for(i = 0; i < n; i++) { |
| key = Getitem(keys, i); |
| el = Getattr(tb, key); |
| |
| String *className = Getitem(el, 0); |
| char *ptr = Char(key); |
| int klen = Len(key); |
| int isSet = 0; |
| if (klen > 4) { |
| ptr = &ptr[klen - 4]; |
| isSet = strcmp(ptr, "_set") == 0; |
| } |
| |
| if(outputNamespaceInfo) |
| Printf(s_namespace, "\"%s\"%s", className, i < n-1 ? "," : ""); |
| } |
| if(n && outputNamespaceInfo) { |
| Printf(s_namespace, ")\n"); |
| } |
| |
| return n; |
| } |
| |
| // end not used |
| #endif |
| /* -------------------------------------------------------------- |
| * Write the methods for $ or $<- for accessing a member field in an |
| * struct or union (or class). |
| * className - the name of the struct or union (e.g. Bar for struct Bar) |
| * isSet - a logical value indicating whether the method is for |
| * modifying ($<-) or accessing ($) the member field. |
| * el - a list of length 2 * # accessible member elements + 1. |
| * The first element is the name of the class. |
| * The other pairs are member name and the name of the R function to access it. |
| * out - the stream where we write the code. |
| * --------------------------------------------------------------*/ |
| |
| int R::OutputMemberReferenceMethod(String *className, int isSet, |
| List *memberList, List *nameList, |
| List *typeList, File *out) { |
| int numMems = Len(memberList), j; |
| int varaccessor = 0; |
| if (numMems == 0) |
| return SWIG_OK; |
| |
| Wrapper *f = NewWrapper(), *attr = NewWrapper(); |
| |
| Printf(f->def, "function(x, name%s)", isSet ? ", value" : ""); |
| Printf(attr->def, "function(x, i, j, ...%s)", isSet ? ", value" : ""); |
| |
| Printf(f->code, "{\n"); |
| Printf(f->code, "%saccessorFuns = list(", tab8); |
| |
| Node *itemList = NewHash(); |
| bool has_prev = false; |
| for(j = 0; j < numMems; j++) { |
| String *item = Getitem(memberList, j); |
| String *dup = Getitem(nameList, j); |
| String *setgetmethod = Getitem(typeList, j); |
| |
| if (setgetmethod == R_MEMBER_GET) |
| varaccessor++; |
| |
| if (Getattr(itemList, item)) |
| continue; |
| Setattr(itemList, item, "1"); |
| |
| String *pitem; |
| if (!Strcmp(item, "operator ()")) { |
| pitem = NewString("call"); |
| } else if (!Strcmp(item, "operator ->")) { |
| pitem = NewString("deref"); |
| } else if (!Strcmp(item, "operator +")) { |
| pitem = NewString("add"); |
| } else if (!Strcmp(item, "operator -")) { |
| pitem = NewString("sub"); |
| } else { |
| pitem = Copy(item); |
| } |
| if (has_prev) |
| Printf(f->code, ", "); |
| Printf(f->code, "'%s' = %s", pitem, dup); |
| has_prev = true; |
| Delete(pitem); |
| } |
| Delete(itemList); |
| Printf(f->code, ");\n"); |
| |
| if (!isSet && varaccessor > 0) { |
| Printf(f->code, "%svaccessors = c(", tab8); |
| bool first = true; |
| for(j = 0; j < numMems; j++) { |
| String *item = Getitem(memberList, j); |
| String *setgetmethod = Getitem(typeList, j); |
| |
| // Check the type here instead of the name |
| if (setgetmethod == R_MEMBER_GET) { |
| Printf(f->code, "%s'%s'", first ? "" : ", ", item); |
| first = false; |
| } |
| } |
| Printf(f->code, ");\n"); |
| } |
| |
| Printv(f->code, ";", tab8, |
| "idx = pmatch(name, names(accessorFuns));\n", |
| tab8, |
| "if(is.na(idx)) \n", |
| tab8, tab4, NIL); |
| Printf(f->code, "return(callNextMethod(x, name%s));\n", |
| isSet ? ", value" : ""); |
| Printv(f->code, tab8, "f = accessorFuns[[idx]];\n", NIL); |
| if(isSet) { |
| Printv(f->code, tab8, "f(x, value);\n", NIL); |
| Printv(f->code, tab8, "x;\n", NIL); // make certain to return the S value. |
| } else { |
| if (varaccessor) { |
| Printv(f->code, tab8, |
| "if (is.na(match(name, vaccessors))) function(...){f(x, ...)} else f(x);\n", NIL); |
| } else { |
| Printv(f->code, tab8, "function(...){f(x, ...)};\n", NIL); |
| } |
| } |
| Printf(f->code, "}\n"); |
| |
| String *classname_str = SwigType_namestr(className); |
| Printf(out, "# Start of accessor method for %s\n", classname_str); |
| Printf(out, "setMethod('$%s', '_p%s', ", |
| isSet ? "<-" : "", |
| getRClassName(className)); |
| Wrapper_print(f, out); |
| Printf(out, ");\n"); |
| |
| if(isSet) { |
| Printf(out, "setMethod('[[<-', c('_p%s', 'character'),", |
| getRClassName(className)); |
| Insert(f->code, 2, "name = i;\n"); |
| Printf(attr->code, "%s", f->code); |
| Wrapper_print(attr, out); |
| Printf(out, ");\n"); |
| } |
| |
| Printf(out, "# end of accessor method for %s\n", classname_str); |
| |
| Delete(classname_str); |
| DelWrapper(attr); |
| DelWrapper(f); |
| |
| return SWIG_OK; |
| } |
| |
| /* ------------------------------------------------------------- |
| * Called when a enumeration is to be processed. |
| * We want to call the R function defineEnumeration(). |
| * tdname is the typedef of the enumeration, i.e. giving its name. |
| * --------------------------------------------------------------*/ |
| |
| int R::enumDeclaration(Node *n) { |
| if (!ImportMode) { |
| if (getCurrentClass() && (cplus_mode != PUBLIC)) |
| return SWIG_NOWRAP; |
| |
| String *symname = Getattr(n, "sym:name"); |
| |
| // TODO - deal with anonymous enumerations |
| // Previous enum code for R didn't wrap them |
| if (!symname || Getattr(n, "unnamedinstance")) |
| return SWIG_NOWRAP; |
| |
| // create mangled name for the enum |
| // This will have content if the %nspace feature is set on |
| // the input file |
| String *nspace = Getattr(n, "sym:nspace"); // NSpace/getNSpace() only works during Language::enumDeclaration call |
| String *ename; |
| |
| String *name = Getattr(n, "name"); |
| ename = getRClassName(name); |
| if (debugMode) { |
| Node *current_class = getCurrentClass(); |
| String *cl = NewString(""); |
| if (current_class) { |
| cl = getEnumClassPrefix(); |
| } |
| Printf(stdout, "enumDeclaration: %s, %s, %s, %s, %s\n", name, symname, nspace, ename, cl); |
| } |
| Delete(name); |
| // set up a call to create the R enum structure. The list of |
| // individual elements will be built in enum_code |
| enum_values = 0; |
| // Emit each enum item |
| Language::enumDeclaration(n); |
| |
| Printf(enum_def_calls, "defineEnumeration(\"%s\",\n .values=c(%s))\n\n", ename, enum_values); |
| Delete(enum_values); |
| Delete(ename); |
| } |
| return SWIG_OK; |
| } |
| |
| /* ------------------------------------------------------------- |
| * --------------------------------------------------------------*/ |
| |
| int R::enumvalueDeclaration(Node *n) { |
| if (getCurrentClass() && (cplus_mode != PUBLIC)) { |
| Printf(stdout, "evd: Not public\n"); |
| return SWIG_NOWRAP; |
| } |
| |
| Swig_require("enumvalueDeclaration", n, "*name", "?value", NIL); |
| String *symname = Getattr(n, "sym:name"); |
| String *value = Getattr(n, "value"); |
| String *name = Getattr(n, "name"); |
| Node *parent = parentNode(n); |
| String *parent_name = Getattr(parent, "name"); |
| String *newsymname = 0; |
| String *tmpValue; |
| |
| // Strange hack from parent method |
| if (value) |
| tmpValue = NewString(value); |
| else |
| tmpValue = NewString(name); |
| // Note that this is used in enumValue() amongst other places |
| Setattr(n, "value", tmpValue); |
| |
| // Deal with enum values that are not int |
| int swigtype = SwigType_type(Getattr(n, "type")); |
| if (swigtype == T_BOOL) { |
| const char *val = Equal(Getattr(n, "enumvalue"), "true") ? "1" : "0"; |
| Setattr(n, "enumvalue", val); |
| } else if (swigtype == T_CHAR) { |
| String *val = NewStringf("'%s'", Getattr(n, "enumvalue")); |
| Setattr(n, "enumvalue", val); |
| Delete(val); |
| } |
| |
| if (GetFlag(parent, "scopedenum")) { |
| newsymname = Swig_name_member(0, Getattr(parent, "sym:name"), symname); |
| symname = newsymname; |
| } |
| |
| { |
| // Wrap C/C++ enums with constant integers or use the typesafe enum pattern |
| SwigType *typemap_lookup_type = parent_name ? parent_name : NewString("enum "); |
| if (debugMode) { |
| Printf(stdout, "Setting type: %s\n", Copy(typemap_lookup_type)); |
| } |
| Setattr(n, "type", typemap_lookup_type); |
| |
| // Simple integer constants |
| // Note these are always generated for anonymous enums, no matter what enum_feature is specified |
| // Code generated is the same for SimpleEnum and TypeunsafeEnum -> the class it is generated into is determined later |
| |
| String *value = enumValue(n); |
| if (enum_values) { |
| Printf(enum_values, ",\n\"%s\" = %s", name, value); |
| } else { |
| enum_values = NewString(""); |
| Printf(enum_values, "\"%s\" = %s", name, value); |
| } |
| |
| Delete(value); |
| } |
| |
| return SWIG_OK; |
| } |
| |
| |
| /* ------------------------------------------------------------- |
| * Create accessor functions for variables. |
| * Does not create equivalent wrappers for enumerations, |
| * which are handled differently |
| * --------------------------------------------------------------*/ |
| |
| int R::variableWrapper(Node *n) { |
| String *name = Getattr(n, "sym:name"); |
| if (debugMode) { |
| Printf(stdout, "variableWrapper %s\n", n); |
| } |
| processing_variable = 1; |
| Language::variableWrapper(n); // Force the emission of the _set and _get function wrappers. |
| processing_variable = 0; |
| |
| |
| SwigType *ty = Getattr(n, "type"); |
| String *nodeType = nodeType(n); |
| int addCopyParam = addCopyParameter(ty); |
| |
| //XXX |
| processType(ty, n); |
| |
| if (nodeType && !Strcmp(nodeType, "enumitem")) { |
| /* special wrapper for enums - don't want the R _set, _get functions*/ |
| if (debugMode) { |
| Printf(stdout, "variableWrapper enum branch\n"); |
| } |
| } else if(!SwigType_isconst(ty)) { |
| Wrapper *f = NewWrapper(); |
| Printf(f->def, "%s = \nfunction(value%s)\n{\n", |
| name, addCopyParam ? ", .copy = FALSE" : ""); |
| Printv(f->code, "if(missing(value)) {\n", |
| name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL); |
| Printv(f->code, " else {\n", |
| name, "_set(value)\n}\n}", NIL); |
| |
| Wrapper_print(f, sfile); |
| DelWrapper(f); |
| } else { |
| Printf(sfile, "%s = %s_get\n", name, name); |
| } |
| |
| return SWIG_OK; |
| } |
| |
| /* ------------------------------------------------------------- |
| * Creates accessor functions for class members. |
| |
| * ToDo - this version depends on naming conventions and needs |
| * to be replaced. |
| * --------------------------------------------------------------*/ |
| |
| void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, |
| String *methodSetGet) { |
| |
| if (!class_member_function_names) { |
| class_member_function_names = NewList(); |
| class_member_function_membernames = NewList(); |
| class_member_function_wrappernames = NewList(); |
| class_member_function_types = NewList(); |
| } |
| Append(class_member_function_types, methodSetGet); |
| Append(class_member_function_names, name); |
| Append(class_member_function_membernames, memberName); |
| |
| String *tmp = NewString(""); |
| Wrapper_print(wrapper, tmp); |
| Append(class_member_function_wrappernames, tmp); |
| // if we could put the wrapper in directly: Append(l, Copy(sfun)); |
| if (debugMode) |
| Printf(stdout, "Adding accessor: %s (%s) => %s\n", memberName, name, tmp); |
| } |
| |
| #define MAX_OVERLOAD 256 |
| |
| struct Overloaded { |
| Node *n; /* Node */ |
| int argc; /* Argument count */ |
| ParmList *parms; /* Parameters used for overload check */ |
| int error; /* Ambiguity error */ |
| }; |
| |
| |
| List * R::Swig_overload_rank(Node *n, |
| bool script_lang_wrapping) { |
| Overloaded nodes[MAX_OVERLOAD]; |
| int nnodes = 0; |
| Node *o = Getattr(n,"sym:overloaded"); |
| |
| |
| if (!o) return 0; |
| |
| Node *c = o; |
| while (c) { |
| if (Getattr(c,"error")) { |
| c = Getattr(c,"sym:nextSibling"); |
| continue; |
| } |
| /* Make a list of all the declarations (methods) that are overloaded with |
| * this one particular method name */ |
| |
| if (Getattr(c,"wrap:name")) { |
| nodes[nnodes].n = c; |
| nodes[nnodes].parms = Getattr(c,"wrap:parms"); |
| nodes[nnodes].argc = emit_num_required(nodes[nnodes].parms); |
| nodes[nnodes].error = 0; |
| nnodes++; |
| } |
| c = Getattr(c,"sym:nextSibling"); |
| } |
| |
| /* Sort the declarations by required argument count */ |
| { |
| int i,j; |
| for (i = 0; i < nnodes; i++) { |
| for (j = i+1; j < nnodes; j++) { |
| if (nodes[i].argc > nodes[j].argc) { |
| Overloaded t = nodes[i]; |
| nodes[i] = nodes[j]; |
| nodes[j] = t; |
| } |
| } |
| } |
| } |
| |
| /* Sort the declarations by argument types */ |
| { |
| int i,j; |
| for (i = 0; i < nnodes-1; i++) { |
| if (nodes[i].argc == nodes[i+1].argc) { |
| for (j = i+1; (j < nnodes) && (nodes[j].argc == nodes[i].argc); j++) { |
| Parm *p1 = nodes[i].parms; |
| Parm *p2 = nodes[j].parms; |
| int differ = 0; |
| int num_checked = 0; |
| while (p1 && p2 && (num_checked < nodes[i].argc)) { |
| if (debugMode) { |
| Printf(stdout,"p1 = '%s', p2 = '%s'\n", Getattr(p1,"type"), Getattr(p2,"type")); |
| } |
| if (checkAttribute(p1,"tmap:in:numinputs","0")) { |
| p1 = Getattr(p1,"tmap:in:next"); |
| continue; |
| } |
| if (checkAttribute(p2,"tmap:in:numinputs","0")) { |
| p2 = Getattr(p2,"tmap:in:next"); |
| continue; |
| } |
| String *t1 = Getattr(p1,"tmap:typecheck:precedence"); |
| String *t2 = Getattr(p2,"tmap:typecheck:precedence"); |
| if (debugMode) { |
| Printf(stdout,"t1 = '%s', t2 = '%s'\n", t1, t2); |
| } |
| if ((!t1) && (!nodes[i].error)) { |
| Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "Overloaded method %s not supported (incomplete type checking rule - no precedence level in typecheck typemap for '%s').\n", |
| Swig_name_decl(nodes[i].n), SwigType_str(Getattr(p1, "type"), 0)); |
| nodes[i].error = 1; |
| } else if ((!t2) && (!nodes[j].error)) { |
| Swig_warning(WARN_TYPEMAP_TYPECHECK, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s not supported (incomplete type checking rule - no precedence level in typecheck typemap for '%s').\n", |
| Swig_name_decl(nodes[j].n), SwigType_str(Getattr(p2, "type"), 0)); |
| nodes[j].error = 1; |
| } |
| if (t1 && t2) { |
| int t1v, t2v; |
| t1v = atoi(Char(t1)); |
| t2v = atoi(Char(t2)); |
| differ = t1v-t2v; |
| } |
| else if (!t1 && t2) differ = 1; |
| else if (t1 && !t2) differ = -1; |
| else if (!t1 && !t2) differ = -1; |
| num_checked++; |
| if (differ > 0) { |
| Overloaded t = nodes[i]; |
| nodes[i] = nodes[j]; |
| nodes[j] = t; |
| break; |
| } else if ((differ == 0) && (Strcmp(t1,"0") == 0)) { |
| t1 = Getattr(p1,"ltype"); |
| if (!t1) { |
| t1 = SwigType_ltype(Getattr(p1,"type")); |
| if (Getattr(p1,"tmap:typecheck:SWIGTYPE")) { |
| SwigType_add_pointer(t1); |
| } |
| Setattr(p1,"ltype",t1); |
| } |
| t2 = Getattr(p2,"ltype"); |
| if (!t2) { |
| t2 = SwigType_ltype(Getattr(p2,"type")); |
| if (Getattr(p2,"tmap:typecheck:SWIGTYPE")) { |
| SwigType_add_pointer(t2); |
| } |
| Setattr(p2,"ltype",t2); |
| } |
| |
| /* Need subtype check here. If t2 is a subtype of t1, then we need to change the |
| order */ |
| |
| if (SwigType_issubtype(t2,t1)) { |
| Overloaded t = nodes[i]; |
| nodes[i] = nodes[j]; |
| nodes[j] = t; |
| } |
| |
| if (Strcmp(t1,t2) != 0) { |
| differ = 1; |
| break; |
| } |
| } else if (differ) { |
| break; |
| } |
| if (Getattr(p1,"tmap:in:next")) { |
| p1 = Getattr(p1,"tmap:in:next"); |
| } else { |
| p1 = nextSibling(p1); |
| } |
| if (Getattr(p2,"tmap:in:next")) { |
| p2 = Getattr(p2,"tmap:in:next"); |
| } else { |
| p2 = nextSibling(p2); |
| } |
| } |
| if (!differ) { |
| /* See if declarations differ by const only */ |
| String *d1 = Getattr(nodes[i].n, "decl"); |
| String *d2 = Getattr(nodes[j].n, "decl"); |
| if (d1 && d2) { |
| String *dq1 = Copy(d1); |
| String *dq2 = Copy(d2); |
| if (SwigType_isconst(d1)) { |
| Delete(SwigType_pop(dq1)); |
| } |
| if (SwigType_isconst(d2)) { |
| Delete(SwigType_pop(dq2)); |
| } |
| if (Strcmp(dq1, dq2) == 0) { |
| |
| if (SwigType_isconst(d1) && !SwigType_isconst(d2)) { |
| if (script_lang_wrapping) { |
| // Swap nodes so that the const method gets ignored (shadowed by the non-const method) |
| Overloaded t = nodes[i]; |
| nodes[i] = nodes[j]; |
| nodes[j] = t; |
| } |
| differ = 1; |
| if (!nodes[j].error) { |
| if (script_lang_wrapping) { |
| Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n)); |
| } else { |
| if (!Getattr(nodes[j].n, "overload:ignore")) { |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "using %s instead.\n", Swig_name_decl(nodes[i].n)); |
| } |
| } |
| } |
| nodes[j].error = 1; |
| } else if (!SwigType_isconst(d1) && SwigType_isconst(d2)) { |
| differ = 1; |
| if (!nodes[j].error) { |
| if (script_lang_wrapping) { |
| Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_CONST, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "using non-const method %s instead.\n", Swig_name_decl(nodes[i].n)); |
| } else { |
| if (!Getattr(nodes[j].n, "overload:ignore")) { |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "using %s instead.\n", Swig_name_decl(nodes[i].n)); |
| } |
| } |
| } |
| nodes[j].error = 1; |
| } |
| } |
| Delete(dq1); |
| Delete(dq2); |
| } |
| } |
| if (!differ) { |
| if (!nodes[j].error) { |
| if (script_lang_wrapping) { |
| Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s effectively ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "as it is shadowed by %s.\n", Swig_name_decl(nodes[i].n)); |
| } else { |
| if (!Getattr(nodes[j].n, "overload:ignore")) { |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), |
| "Overloaded method %s ignored,\n", Swig_name_decl(nodes[j].n)); |
| Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), |
| "using %s instead.\n", Swig_name_decl(nodes[i].n)); |
| } |
| } |
| nodes[j].error = 1; |
| } |
| } |
| } |
| } |
| } |
| } |
| List *result = NewList(); |
| { |
| int i; |
| for (i = 0; i < nnodes; i++) { |
| if (nodes[i].error) |
| Setattr(nodes[i].n, "overload:ignore", "1"); |
| Append(result,nodes[i].n); |
| // Printf(stdout,"[ %d ] %s\n", i, ParmList_errorstr(nodes[i].parms)); |
| // Swig_print_node(nodes[i].n); |
| } |
| } |
| return result; |
| } |
| |
| void R::dispatchFunction(Node *n) { |
| Wrapper *f = NewWrapper(); |
| String *symname = Getattr(n, "sym:name"); |
| String *nodeType = Getattr(n, "nodeType"); |
| bool constructor = (!Cmp(nodeType, "constructor")); |
| |
| String *sfname = NewString(symname); |
| |
| if (constructor) |
| Replace(sfname, "new_", "", DOH_REPLACE_FIRST); |
| |
| Printf(f->def, |
| "`%s` <- function(...) {", sfname); |
| if (debugMode) { |
| Swig_print_node(n); |
| } |
| List *dispatch = Swig_overload_rank(n, true); |
| int nfunc = Len(dispatch); |
| Printv(f->code, |
| "argtypes <- mapply(class, list(...));\n", |
| "argv <- list(...);\n", |
| "argc <- length(argtypes);\n", NIL ); |
| |
| Printf(f->code, "# dispatch functions %d\n", nfunc); |
| int cur_args = -1; |
| bool first_compare = true; |
| for (int i=0; i < nfunc; i++) { |
| Node *ni = Getitem(dispatch,i); |
| Parm *pi = Getattr(ni,"wrap:parms"); |
| int num_arguments = emit_num_arguments(pi); |
| |
| String *overname = Getattr(ni,"sym:overname"); |
| if (cur_args != num_arguments) { |
| if (cur_args != -1) { |
| Printv(f->code, "} else ", NIL); |
| } |
| Printf(f->code, "if (argc == %d) {", num_arguments); |
| cur_args = num_arguments; |
| first_compare = true; |
| } |
| Parm *p; |
| int j; |
| if (num_arguments > 0) { |
| if (!first_compare) { |
| Printv(f->code, " else ", NIL); |
| } else { |
| first_compare = false; |
| } |
| Printv(f->code, "if (", NIL); |
| for (p =pi, j = 0 ; j < num_arguments ; j++) { |
| if (debugMode) { |
| Swig_print_node(p); |
| } |
| String *tm = Swig_typemap_lookup("rtype", p, "", 0); |
| if(tm) { |
| replaceRClass(tm, Getattr(p, "type")); |
| } |
| |
| String *tmcheck = Swig_typemap_lookup("rtypecheck", p, "", 0); |
| if (tmcheck) { |
| String *tmp = NewString(""); |
| Printf(tmp, "argv[[%d]]", j+1); |
| Replaceall(tmcheck, "$arg", tmp); |
| Printf(tmp, "argtype[%d]", j+1); |
| Replaceall(tmcheck, "$argtype", tmp); |
| if (tm) { |
| Replaceall(tmcheck, "$rtype", tm); |
| } |
| if (debugMode) { |
| Printf(stdout, "<rtypecheck>%s\n", tmcheck); |
| } |
| Printf(f->code, "%s(%s)", |
| j == 0 ? "" : " && ", |
| tmcheck); |
| p = Getattr(p, "tmap:in:next"); |
| continue; |
| } |
| // Below should be migrated into rtypecheck typemaps |
| if (tm) { |
| Printf(f->code, "%s", j == 0 ? "" : " && "); |
| if (Strcmp(tm, "numeric") == 0) { |
| Printf(f->code, "is.numeric(argv[[%d]])", j+1); |
| } else if (Strcmp(tm, "integer") == 0) { |
| Printf(f->code, "(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", j+1, j+1); |
| } else if (Strcmp(tm, "character") == 0) { |
| Printf(f->code, "is.character(argv[[%d]])", j+1); |
| } else { |
| if (SwigType_ispointer(Getattr(p, "type"))) |
| Printf(f->code, "(extends(argtypes[%d], '%s') || is.null(argv[[%d]]))", j+1, tm, j+1); |
| else |
| Printf(f->code, "extends(argtypes[%d], '%s')", j+1, tm); |
| } |
| } |
| if (!SwigType_ispointer(Getattr(p, "type"))) { |
| Printf(f->code, " && length(argv[[%d]]) == 1", j+1); |
| } |
| p = Getattr(p, "tmap:in:next"); |
| } |
| Printf(f->code, ") { f <- %s%s; }\n", sfname, overname); |
| } else { |
| Printf(f->code, "f <- %s%s; ", sfname, overname); |
| } |
| } |
| if (cur_args != -1) { |
| Printf(f->code, "} else {\n" |
| "stop(\"cannot find overloaded function for %s with argtypes (\"," |
| "toString(argtypes),\")\");\n" |
| "}", sfname); |
| } |
| Printv(f->code, ";\nf(...)", NIL); |
| Printv(f->code, ";\n}", NIL); |
| Wrapper_print(f, sfile); |
| Printv(sfile, "# Dispatch function\n", NIL); |
| DelWrapper(f); |
| } |
| |
| /*-------------------------------------------------------------- |
| |
| * --------------------------------------------------------------*/ |
| |
| int R::functionWrapper(Node *n) { |
| String *fname = Getattr(n, "name"); |
| String *iname = Getattr(n, "sym:name"); |
| String *type = Getattr(n, "type"); |
| |
| if (debugMode) { |
| Printf(stdout, |
| "<functionWrapper> %s %s %s\n", fname, iname, type); |
| } |
| String *overname = 0; |
| String *nodeType = Getattr(n, "nodeType"); |
| bool constructor = (!Cmp(nodeType, "constructor")); |
| bool destructor = (!Cmp(nodeType, "destructor")); |
| |
| String *sfname = NewString(iname); |
| |
| if (constructor) |
| Replace(sfname, "new_", "", DOH_REPLACE_FIRST); |
| |
| if (Getattr(n,"sym:overloaded")) { |
| overname = Getattr(n,"sym:overname"); |
| Append(sfname, overname); |
| } |
| |
| if (debugMode) |
| Printf(stdout, |
| "<functionWrapper> processing parameters\n"); |
| |
| |
| ParmList *l = Getattr(n, "parms"); |
| Parm *p; |
| String *tm; |
| |
| p = l; |
| while(p) { |
| SwigType *resultType = Getattr(p, "type"); |
| if (expandTypedef(resultType) && |
| SwigType_istypedef(resultType)) { |
| SwigType *resolved = |
| SwigType_typedef_resolve_all(resultType); |
| if (expandTypedef(resolved)) { |
| if (debugMode) { |
| Printf(stdout, "Setting type: %s\n", resolved); |
| } |
| Setattr(p, "type", Copy(resolved)); |
| } |
| } |
| p = nextSibling(p); |
| } |
| |
| String *unresolved_return_type = |
| Copy(type); |
| if (expandTypedef(type) && |
| SwigType_istypedef(type)) { |
| SwigType *resolved = |
| SwigType_typedef_resolve_all(type); |
| if (debugMode) |
| Printf(stdout, "<functionWrapper> resolved %s\n", Copy(unresolved_return_type)); |
| if (expandTypedef(resolved)) { |
| type = Copy(resolved); |
| Setattr(n, "type", type); |
| } |
| } |
| if (debugMode) |
| Printf(stdout, "<functionWrapper> unresolved_return_type %s\n", unresolved_return_type); |
| if(processing_member_access_function) { |
| if (debugMode) |
| Printf(stdout, "<functionWrapper memberAccess> '%s' '%s' '%s' '%s'\n", fname, iname, member_name, class_name); |
| |
| if(opaqueClassDeclaration) |
| return SWIG_OK; |
| |
| |
| /* Add the name of this member to a list for this class_name. |
| We will dump all these at the end. */ |
| |
| bool isSet(GetFlag(n, "memberset")); |
| |
| String *tmp = NewString(isSet ? Swig_name_set(NSPACE_TODO, class_name) : Swig_name_get(NSPACE_TODO, class_name)); |
| |
| List *memList = Getattr(ClassMemberTable, tmp); |
| if(!memList) { |
| memList = NewList(); |
| Append(memList, class_name); |
| Setattr(ClassMemberTable, tmp, memList); |
| } |
| Delete(tmp); |
| Append(memList, member_name); |
| Append(memList, iname); |
| } |
| |
| int i; |
| int nargs; |
| |
| String *wname = Swig_name_wrapper(iname); |
| |
| if(overname) |
| Append(wname, overname); |
| Setattr(n,"wrap:name", wname); |
| |
| Wrapper *f = NewWrapper(); |
| Wrapper *sfun = NewWrapper(); |
| |
| int isVoidReturnType = (Strcmp(type, "void") == 0); |
| // Need to use the unresolved return type since |
| // typedef resolution removes the const which causes a |
| // mismatch with the function action |
| emit_return_variable(n, unresolved_return_type, f); |
| |
| SwigType *rtype = Getattr(n, "type"); |
| int addCopyParam = 0; |
| |
| if(!isVoidReturnType) |
| addCopyParam = addCopyParameter(rtype); |
| |
| if (debugMode) |
| Printf(stdout, "Adding a .copy argument to %s for %s = %s\n", |
| iname, type, addCopyParam ? "yes" : "no"); |
| |
| Printv(f->def, "SWIGEXPORT SEXP\n", wname, " ( ", NIL); |
| |
| Printf(sfun->def, "# Start of %s\n", iname); |
| Printv(sfun->def, "\n`", sfname, "` = function(", NIL); |
| |
| if(outputNamespaceInfo) {//XXX Need to be a little more discriminating |
| if (constructor) { |
| String *niname = Copy(iname); |
| Replace(niname, "new_", "", DOH_REPLACE_FIRST); |
| addNamespaceFunction(niname); |
| Delete(niname); |
| } else { |
| addNamespaceFunction(iname); |
| } |
| } |
| |
| Swig_typemap_attach_parms("scoercein", l, f); |
| Swig_typemap_attach_parms("scoerceout", l, f); |
| Swig_typemap_attach_parms("scheck", l, f); |
| |
| emit_parameter_variables(l, f); |
| emit_attach_parmmaps(l,f); |
| Setattr(n,"wrap:parms",l); |
| |
| nargs = emit_num_arguments(l); |
| |
| Wrapper_add_local(f, "r_nprotect", "unsigned int r_nprotect = 0"); |
| Wrapper_add_localv(f, "r_ans", "SEXP", "r_ans = R_NilValue", NIL); |
| Wrapper_add_localv(f, "r_vmax", "VMAXTYPE", "r_vmax = vmaxget()", NIL); |
| |
| String *sargs = NewString(""); |
| |
| |
| String *s_inputTypes = NewString(""); |
| String *s_inputMap = NewString(""); |
| bool inFirstArg = true; |
| bool inFirstType = true; |
| Parm *curP; |
| for (p =l, i = 0 ; i < nargs ; i++) { |
| |
| while (checkAttribute(p, "tmap:in:numinputs", "0")) { |
| p = Getattr(p, "tmap:in:next"); |
| } |
| |
| SwigType *tt = Getattr(p, "type"); |
| int nargs = -1; |
| String *funcptr_name = processType(tt, p, &nargs); |
| |
| // SwigType *tp = Getattr(p, "type"); |
| String *name = Getattr(p,"name"); |
| String *lname = Getattr(p,"lname"); |
| |
| // R keyword renaming |
| if (name) { |
| if (Swig_name_warning(p, 0, name, 0)) { |
| name = 0; |
| } else { |
| /* If we have a :: in the parameter name because we are accessing a static member of a class, say, then |
| we need to remove that prefix. */ |
| while (Strstr(name, "::")) { |
| //XXX need to free. |
| name = NewStringf("%s", Strchr(name, ':') + 2); |
| if (debugMode) |
| Printf(stdout, "+++ parameter name with :: in it %s\n", name); |
| } |
| } |
| } |
| if (!name || Len(name) == 0) |
| name = NewStringf("s_arg%d", i+1); |
| |
| name = replaceInitialDash(name); |
| |
| if (!Strncmp(name, "arg", 3)) { |
| name = Copy(name); |
| Insert(name, 0, "s_"); |
| } |
| |
| if(processing_variable) { |
| name = Copy(name); |
| Insert(name, 0, "s_"); |
| } |
| |
| if(!Strcmp(name, fname)) { |
| name = Copy(name); |
| Insert(name, 0, "s_"); |
| } |
| |
| Printf(sargs, "%s, ", name); |
| |
| String *tm; |
| if((tm = Getattr(p, "tmap:scoercein"))) { |
| Replaceall(tm, "$input", name); |
| replaceRClass(tm, Getattr(p, "type")); |
| |
| if(funcptr_name) { |
| //XXX need to get this to return non-zero |
| if(nargs == -1) |
| nargs = getFunctionPointerNumArgs(p, tt); |
| |
| String *snargs = NewStringf("%d", nargs); |
| Printv(sfun->code, "if(is.function(", name, ")) {", "\n", |
| "assert('...' %in% names(formals(", name, |
| ")) || length(formals(", name, ")) >= ", snargs, ");\n} ", NIL); |
| Delete(snargs); |
| |
| Printv(sfun->code, "else {\n", |
| "if(is.character(", name, ")) {\n", |
| name, " = getNativeSymbolInfo(", name, ");", |
| "\n};\n", |
| "if(is(", name, ", \"NativeSymbolInfo\")) {\n", |
| name, " = ", name, "$address", ";\n}\n", |
| "if(is(", name, ", \"ExternalReference\")) {\n", |
| name, " = ", name, "@ref;\n}\n", |
| "}; \n", |
| NIL); |
| } else { |
| Printf(sfun->code, "%s\n", tm); |
| } |
| } |
| |
| Printv(sfun->def, inFirstArg ? "" : ", ", name, NIL); |
| |
| if ((tm = Getattr(p,"tmap:scheck"))) { |
| |
| Replaceall(tm,"$target", lname); |
| Replaceall(tm,"$source", name); |
| Replaceall(tm,"$input", name); |
| replaceRClass(tm, Getattr(p, "type")); |
| Printf(sfun->code,"%s\n",tm); |
| } |
| |
| |
| |
| curP = p; |
| if ((tm = Getattr(p,"tmap:in"))) { |
| |
| Replaceall(tm,"$target", lname); |
| Replaceall(tm,"$source", name); |
| Replaceall(tm,"$input", name); |
| |
| if (Getattr(p,"wrap:disown") || (Getattr(p,"tmap:in:disown"))) { |
| Replaceall(tm,"$disown","SWIG_POINTER_DISOWN"); |
| } else { |
| Replaceall(tm,"$disown","0"); |
| } |
| |
| if(funcptr_name) { |
| /* have us a function pointer */ |
| Printf(f->code, "if(TYPEOF(%s) != CLOSXP) {\n", name); |
| Replaceall(tm,"$R_class", ""); |
| } else { |
| replaceRClass(tm, Getattr(p, "type")); |
| } |
| |
| |
| Printf(f->code,"%s\n",tm); |
| if(funcptr_name) |
| Printf(f->code, "} else {\n%s = %s;\nR_SWIG_pushCallbackFunctionData(%s, NULL);\n}\n", |
| lname, funcptr_name, name); |
| Printv(f->def, inFirstArg ? "" : ", ", "SEXP ", name, NIL); |
| if (Len(name) != 0) |
| inFirstArg = false; |
| p = Getattr(p,"tmap:in:next"); |
| |
| } else { |
| p = nextSibling(p); |
| } |
| |
| |
| tm = Swig_typemap_lookup("rtype", curP, "", 0); |
| if(tm) { |
| replaceRClass(tm, Getattr(curP, "type")); |
| } |
| Printf(s_inputTypes, "%s'%s'", inFirstType ? "" : ", ", tm); |
| Printf(s_inputMap, "%s%s='%s'", inFirstType ? "" : ", ", name, tm); |
| inFirstType = false; |
| |
| if(funcptr_name) |
| Delete(funcptr_name); |
| } /* end of looping over parameters. */ |
| |
| if(addCopyParam) { |
| Printf(sfun->def, "%s.copy = FALSE", nargs > 0 ? ", " : ""); |
| Printf(f->def, "%sSEXP s_swig_copy", nargs > 0 ? ", " : ""); |
| |
| Printf(sargs, "as.logical(.copy), "); |
| } |
| |
| Printv(f->def, ")\n{\n", NIL); |
| Printv(sfun->def, ")\n{\n", NIL); |
| |
| |
| /* Insert cleanup code */ |
| String *cleanup = NewString(""); |
| for (p = l; p;) { |
| if ((tm = Getattr(p, "tmap:freearg"))) { |
| Replaceall(tm, "$source", Getattr(p, "lname")); |
| if (tm && (Len(tm) != 0)) { |
| Printv(cleanup, tm, "\n", NIL); |
| } |
| p = Getattr(p, "tmap:freearg:next"); |
| } else { |
| p = nextSibling(p); |
| } |
| } |
| |
| String *outargs = NewString(""); |
| int numOutArgs = isVoidReturnType ? -1 : 0; |
| for(p = l, i = 0; p; i++) { |
| if((tm = Getattr(p, "tmap:argout"))) { |
| // String *lname = Getattr(p, "lname"); |
| numOutArgs++; |
| String *pos = NewStringf("%d", numOutArgs); |
| Replaceall(tm,"$source", Getattr(p, "lname")); |
| Replaceall(tm,"$result", "r_ans"); |
| Replaceall(tm,"$n", pos); // The position into which to store the answer. |
| Replaceall(tm,"$arg", Getattr(p, "emit:input")); |
| Replaceall(tm,"$input", Getattr(p, "emit:input")); |
| Replaceall(tm,"$owner", "0"); |
| |
| |
| Printf(outargs, "%s\n", tm); |
| p = Getattr(p,"tmap:argout:next"); |
| } else |
| p = nextSibling(p); |
| } |
| |
| String *actioncode = emit_action(n); |
| |
| /* Deal with the explicit return value. */ |
| if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) { |
| SwigType *retType = Getattr(n, "type"); |
| |
| Replaceall(tm,"$1", Swig_cresult_name()); |
| Replaceall(tm,"$result", "r_ans"); |
| if (debugMode){ |
| Printf(stdout, "Calling replace D: %s, %s, %s\n", retType, n, tm); |
| } |
| replaceRClass(tm, retType); |
| |
| if (GetFlag(n,"feature:new")) { |
| Replaceall(tm, "$owner", "SWIG_POINTER_OWN"); |
| } else { |
| Replaceall(tm,"$owner", "0"); |
| } |
| |
| Printf(f->code, "%s\n", tm); |
| |
| } else { |
| Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, |
| "Unable to use return type %s in function %s.\n", SwigType_str(type, 0), fname); |
| } |
| |
| |
| if(Len(outargs)) { |
| Wrapper_add_local(f, "R_OutputValues", "SEXP R_OutputValues"); |
| |
| String *tmp = NewString(""); |
| if(!isVoidReturnType) |
| Printf(tmp, "Rf_protect(r_ans);\n"); |
| |
| Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n", |
| numOutArgs + !isVoidReturnType, |
| isVoidReturnType ? 1 : 2); |
| |
| if(!isVoidReturnType) |
| Printf(tmp, "SET_VECTOR_ELT(R_OutputValues, 0, r_ans);\n"); |
| Printf(tmp, "r_ans = R_OutputValues;\n"); |
| |
| Insert(outargs, 0, tmp); |
| Delete(tmp); |
| |
| |
| |
| Printv(f->code, outargs, NIL); |
| Delete(outargs); |
| |
| } |
| |
| /* Output cleanup code */ |
| int need_cleanup = Len(cleanup) != 0; |
| if (need_cleanup) { |
| Printv(f->code, cleanup, NIL); |
| } |
| |
| /* Look to see if there is any newfree cleanup code */ |
| if (GetFlag(n, "feature:new")) { |
| if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) { |
| Replaceall(tm, "$source", Swig_cresult_name()); /* deprecated */ |
| Printf(f->code, "%s\n", tm); |
| } |
| } |
| |
| /* See if there is any return cleanup code */ |
| if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) { |
| Replaceall(tm, "$source", Swig_cresult_name()); |
| Printf(f->code, "%s\n", tm); |
| Delete(tm); |
| } |
| |
| Printv(f->code, UnProtectWrapupCode, NIL); |
| |
| /*If the user gave us something to convert the result in */ |
| if ((tm = Swig_typemap_lookup("scoerceout", n, Swig_cresult_name(), sfun))) { |
| Replaceall(tm,"$source","ans"); |
| Replaceall(tm,"$result","ans"); |
| if (constructor) { |
| Node * parent = Getattr(n, "parentNode"); |
| String * smartname = Getattr(parent, "feature:smartptr"); |
| if (smartname) { |
| smartname = getRClassName(smartname, 1, 1); |
| Replaceall(tm, "$R_class", smartname); |
| Delete(smartname); |
| } |
| } |
| if (debugMode) { |
| Printf(stdout, "Calling replace B: %s, %s, %s\n", Getattr(n, "type"), Getattr(n, "sym:name"), getNSpace()); |
| } |
| replaceRClass(tm, Getattr(n, "type")); |
| Chop(tm); |
| } |
| |
| |
| Printv(sfun->code, ";", (Len(tm) ? "ans = " : ""), ".Call('", wname, |
| "', ", sargs, "PACKAGE='", Rpackage, "');\n", NIL); |
| if(Len(tm)) |
| { |
| Printf(sfun->code, "%s\n\n", tm); |
| if (constructor) |
| { |
| String *finalizer = NewString(iname); |
| Replace(finalizer, "new_", "", DOH_REPLACE_FIRST); |
| Printf(sfun->code, "reg.finalizer(ans@ref, delete_%s)\n", finalizer); |
| } |
| Printf(sfun->code, "ans\n"); |
| } |
| |
| if (destructor) |
| Printv(f->code, "R_ClearExternalPtr(self);\n", NIL); |
| |
| Printv(f->code, "return r_ans;\n", NIL); |
| |
| /* Error handling code */ |
| Printv(f->code, "fail: SWIGUNUSED;\n", NIL); |
| if (need_cleanup) { |
| Printv(f->code, cleanup, NIL); |
| } |
| Printv(f->code, " Rf_error(\"%s %s\", SWIG_ErrorType(SWIG_lasterror_code), SWIG_lasterror_msg);\n", NIL); |
| Printv(f->code, " return R_NilValue;\n", NIL); |
| Delete(cleanup); |
| |
| Printv(f->code, "}\n", NIL); |
| Printv(sfun->code, "\n}", NIL); |
| |
| /* Substitute the function name */ |
| Replaceall(f->code,"$symname",iname); |
| |
| Wrapper_print(f, f_wrapper); |
| Wrapper_print(sfun, sfile); |
| |
| Printf(sfun->code, "\n# End of %s\n", iname); |
| tm = Swig_typemap_lookup("rtype", n, "", 0); |
| if(tm) { |
| SwigType *retType = Getattr(n, "type"); |
| if (debugMode) { |
| Printf(stdout, "Calling replace C: %s\n", Copy(retType)); |
| } |
| replaceRClass(tm, retType); |
| } |
| |
| Printv(sfile, "attr(`", sfname, "`, 'returnType') = '", |
| isVoidReturnType ? "void" : (tm ? tm : ""), |
| "'\n", NIL); |
| |
| if(nargs > 0) |
| Printv(sfile, "attr(`", sfname, "`, \"inputTypes\") = c(", |
| s_inputTypes, ")\n", NIL); |
| Printv(sfile, "class(`", sfname, "`) = c(\"SWIGFunction\", class('", |
| sfname, "'))\n\n", NIL); |
| |
| if (memoryProfile) { |
| Printv(sfile, "memory.profile()\n", NIL); |
| } |
| if (aggressiveGc) { |
| Printv(sfile, "gc()\n", NIL); |
| } |
| |
| // Printv(sfile, "setMethod('", name, "', '", name, "', ", iname, ")\n\n\n"); |
| |
| |
| |
| /* If we are dealing with a method in an C++ class, then |
| add the name of the R function and its definition. |
| XXX need to figure out how to store the Wrapper if possible in the hash/list. |
| Would like to be able to do this so that we can potentially insert |
| */ |
| if(processing_member_access_function || processing_class_member_function) { |
| String *method_type = R_MEMBER_NORMAL; |
| if (GetFlag(n, "memberset")) { |
| method_type = R_MEMBER_SET; |
| } else if (GetFlag(n, "memberget")) { |
| method_type = R_MEMBER_GET; |
| } |
| addAccessor(member_name, sfun, iname, method_type); |
| } |
| |
| if (Getattr(n, "sym:overloaded") && |
| !Getattr(n, "sym:nextSibling")) { |
| dispatchFunction(n); |
| } |
| |
| addRegistrationRoutine(wname, addCopyParam ? nargs +1 : nargs); |
| |
| DelWrapper(f); |
| DelWrapper(sfun); |
| |
| Delete(sargs); |
| Delete(sfname); |
| return SWIG_OK; |
| } |
| |
| /* ---------------------------------------------------------------------- |
| * R::constantWrapper() |
| * ---------------------------------------------------------------------- */ |
| |
| int R::constantWrapper(Node *n) { |
| (void) n; |
| // TODO |
| return SWIG_OK; |
| } |
| |
| /*-------------------------------------------------------------- |
| * Add the specified routine name to the collection of |
| * generated routines that are called from R functions. |
| * This is used to register the routines with R for |
| * resolving symbols. |
| |
| * rname - the name of the routine |
| * nargs - the number of arguments it expects. |
| * --------------------------------------------------------------*/ |
| |
| int R::addRegistrationRoutine(String *rname, int nargs) { |
| if(!registrationTable) |
| registrationTable = NewHash(); |
| |
| String *el = |
| NewStringf("{\"%s\", (DL_FUNC) &%s, %d}", rname, rname, nargs); |
| |
| Setattr(registrationTable, rname, el); |
| |
| return SWIG_OK; |
| } |
| |
| /* ------------------------------------------------------------- |
| * Write the registration information to an array and |
| * create the initialization routine for registering |
| * these. |
| * --------------------------------------------------------------*/ |
| |
| int R::outputRegistrationRoutines(File *out) { |
| int i, n; |
| if(!registrationTable) |
| return(0); |
| if(inCPlusMode) |
| Printf(out, "#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n"); |
| |
| Printf(out, "#include <R_ext/Rdynload.h>\n\n"); |
| if(inCPlusMode) |
| Printf(out, "#ifdef __cplusplus\n}\n#endif\n\n"); |
| |
| Printf(out, "SWIGINTERN R_CallMethodDef CallEntries[] = {\n"); |
| |
| List *keys = Keys(registrationTable); |
| n = Len(keys); |
| for(i = 0; i < n; i++) |
| Printf(out, " %s,\n", Getattr(registrationTable, Getitem(keys, i))); |
| |
| Printf(out, " {NULL, NULL, 0}\n};\n\n"); |
| |
| if(!noInitializationCode) { |
| if (inCPlusMode) |
| Printv(out, "extern \"C\" ", NIL); |
| { /* R allows pckage names to have '.' in the name, which is not allowed in C++ var names |
| we simply replace all occurrences of '.' with '_' to construct the var name */ |
| String * Rpackage_sane = Copy(Rpackage); |
| Replace(Rpackage_sane, ".", "_", DOH_REPLACE_ANY); |
| Printf(out, "SWIGEXPORT void R_init_%s(DllInfo *dll) {\n", Rpackage_sane); |
| Delete(Rpackage_sane); |
| } |
| Printf(out, "%sR_registerRoutines(dll, NULL, CallEntries, NULL, NULL);\n", tab4); |
| if(Len(s_init_routine)) { |
| Printf(out, "\n%s\n", s_init_routine); |
| } |
| Printf(out, "}\n"); |
| } |
| |
| return n; |
| } |
| |
| |
| |
| /* ------------------------------------------------------------- |
| * Process a struct, union or class declaration in the source code, |
| * or an anonymous typedef struct |
| * --------------------------------------------------------------*/ |
| |
| //XXX What do we need to do here - |
| // Define an S4 class to refer to this. |
| |
| void R::registerClass(Node *n) { |
| String *name = Getattr(n, "name"); |
| String *kind = Getattr(n, "kind"); |
| |
| if (debugMode) |
| Swig_print_node(n); |
| String *sname = NewStringf("_p%s", SwigType_manglestr(name)); |
| if(!Getattr(SClassDefs, sname)) { |
| Setattr(SClassDefs, sname, sname); |
| String *base; |
| |
| if(Strcmp(kind, "class") == 0) { |
| base = NewString(""); |
| List *l = Getattr(n, "bases"); |
| if(Len(l)) { |
| Printf(base, "c("); |
| for(int i = 0; i < Len(l); i++) { |
| registerClass(Getitem(l, i)); |
| Printf(base, "'_p%s'%s", |
| SwigType_manglestr(Getattr(Getitem(l, i), "name")), |
| i < Len(l)-1 ? ", " : ""); |
| } |
| Printf(base, ")"); |
| } else { |
| base = NewString("'C++Reference'"); |
| } |
| } else |
| base = NewString("'ExternalReference'"); |
| |
| Printf(s_classes, "setClass('%s', contains = %s)\n", sname, base); |
| Delete(base); |
| String *smartptr = Getattr(n, "feature:smartptr"); |
| if (smartptr) { |
| List *l = Getattr(n, "bases"); |
| SwigType *spt = Swig_cparse_type(smartptr); |
| String *smart = SwigType_typedef_resolve_all(spt); |
| String *smart_rname = SwigType_manglestr(smart); |
| Printf(s_classes, "setClass('_p%s', contains = c('%s'", smart_rname, sname); |
| Delete(spt); |
| Delete(smart); |
| Delete(smart_rname); |
| for(int i = 0; i < Len(l); i++) { |
| Node * b = Getitem(l, i); |
| smartptr = Getattr(b, "feature:smartptr"); |
| if (smartptr) { |
| spt = Swig_cparse_type(smartptr); |
| smart = SwigType_typedef_resolve_all(spt); |
| smart_rname = SwigType_manglestr(smart); |
| Printf(s_classes, ", '_p%s'", smart_rname); |
| Delete(spt); |
| Delete(smart); |
| Delete(smart_rname); |
| } |
| } |
| Printf(s_classes, "))\n"); |
| } |
| } |
| } |
| |
| int R::classDeclaration(Node *n) { |
| |
| String *name = Getattr(n, "name"); |
| String *kind = Getattr(n, "kind"); |
| |
| if (debugMode) |
| Swig_print_node(n); |
| registerClass(n); |
| |
| |
| /* If we have a typedef union { ... } U, then we never get to see the typedef |
| via a regular call to typedefHandler. Instead, */ |
| if(Getattr(n, "unnamed") && Getattr(n, "storage") && Strcmp(Getattr(n, "storage"), "typedef") == 0 |
| && Getattr(n, "tdname") && Strcmp(Getattr(n, "tdname"), name) == 0) { |
| if (debugMode) |
| Printf(stdout, "Typedef in the class declaration for %s\n", name); |
| // typedefHandler(n); |
| } |
| |
| bool opaque = GetFlag(n, "feature:opaque") ? true : false; |
| |
| if(opaque) |
| opaqueClassDeclaration = name; |
| |
| int status = Language::classDeclaration(n); |
| |
| opaqueClassDeclaration = NULL; |
| |
| |
| if (class_member_function_types) { |
| |
| // collect the "set" methods |
| List *class_set_membernames = filterMemberList(class_member_function_types, |
| class_member_function_membernames, R_MEMBER_SET, true); |
| List *class_set_functionnames = filterMemberList(class_member_function_types, |
| class_member_function_names, R_MEMBER_SET, true); |
| // this one isn't used - collecting to keep code simpler |
| List *class_set_functiontypes = filterMemberList(class_member_function_types, |
| class_member_function_types, R_MEMBER_SET, true); |
| |
| // collect the others |
| List *class_other_membernames = filterMemberList(class_member_function_types, |
| class_member_function_membernames, R_MEMBER_SET, false); |
| List *class_other_functionnames = filterMemberList(class_member_function_types, |
| class_member_function_names, R_MEMBER_SET, false); |
| List *class_other_functiontypes = filterMemberList(class_member_function_types, |
| class_member_function_types, R_MEMBER_SET, false); |
| |
| if (Len(class_other_membernames) > 0) { |
| OutputMemberReferenceMethod(name, 0, class_other_membernames, class_other_functionnames, class_other_functiontypes, sfile); |
| } |
| if (Len(class_set_membernames) > 0) { |
| OutputMemberReferenceMethod(name, 1, class_set_membernames, class_set_functionnames, class_set_functiontypes, sfile); |
| } |
| Delete(class_set_membernames); |
| Delete(class_set_functionnames); |
| Delete(class_set_functiontypes); |
| Delete(class_other_membernames); |
| Delete(class_other_functionnames); |
| Delete(class_other_functiontypes); |
| } |
| |
| if (class_member_function_types) { |
| Delete(class_member_function_types); |
| class_member_function_types = NULL; |
| Delete(class_member_function_names); |
| class_member_function_names = NULL; |
| Delete(class_member_function_membernames); |
| class_member_function_membernames = NULL; |
| Delete(class_member_function_wrappernames); |
| class_member_function_wrappernames = NULL; |
| } |
| if (Getattr(n, "has_destructor")) { |
| Printf(sfile, "setMethod('delete', '_p%s', function(obj) {delete%s(obj)})\n", getRClassName(name), getRClassName(name)); |
| |
| } |
| if(!opaque && !Strcmp(kind, "struct") && copyStruct) { |
| |
| String *def = |
| NewStringf("setClass(\"%s\",\n%srepresentation(\n", name, tab4); |
| bool firstItem = true; |
| |
| for(Node *c = firstChild(n); c; ) { |
| String *elName; |
| String *tp; |
| |
| elName = Getattr(c, "name"); |
| |
| String *elKind = Getattr(c, "kind"); |
| if (!Equal(elKind, "variable")) { |
| c = nextSibling(c); |
| continue; |
| } |
| if (!Len(elName)) { |
| c = nextSibling(c); |
| continue; |
| } |
| tp = Swig_typemap_lookup("rtype", c, "", 0); |
| if(!tp) { |
| c = nextSibling(c); |
| continue; |
| } |
| if (Strstr(tp, "R_class")) { |
| c = nextSibling(c); |
| continue; |
| } |
| if (Strcmp(tp, "character") && |
| Strstr(Getattr(c, "decl"), "p.")) { |
| c = nextSibling(c); |
| continue; |
| } |
| |
| if (!firstItem) { |
| Printf(def, ",\n"); |
| } |
| // else |
| //XXX How can we tell if this is already done. |
| // SwigType_push(elType, elDecl); |
| |
| |
| // returns "" tp = processType(elType, c, NULL); |
| // Printf(stdout, "<classDeclaration> elType %p\n", elType); |
| // tp = getRClassNameCopyStruct(Getattr(c, "type"), 1); |
| |
| String *elNameT = replaceInitialDash(elName); |
| Printf(def, "%s%s = \"%s\"", tab8, elNameT, tp); |
| firstItem = false; |
| Delete(tp); |
| Delete(elNameT); |
| c = nextSibling(c); |
| } |
| Printf(def, "),\n%scontains = \"RSWIGStruct\")\n", tab8); |
| Printf(s_classes, "%s\n\n# End class %s\n\n", def, name); |
| |
| generateCopyRoutines(n); |
| |
| Delete(def); |
| } |
| |
| return status; |
| } |
| |
| |
| |
| /* ------------------------------------------------------------- |
| * Create the C routines that copy an S object of the class given |
| * by the given struct definition in Node *n to the C value |
| * and also the routine that goes from the C routine to an object |
| * of this S class. |
| * --------------------------------------------------------------*/ |
| |
| /*XXX |
| Clean up the toCRef - make certain the names are correct for the types, etc. |
| in all cases. |
| */ |
| |
| int R::generateCopyRoutines(Node *n) { |
| Wrapper *copyToR = NewWrapper(); |
| Wrapper *copyToC = NewWrapper(); |
| |
| String *name = Getattr(n, "name"); |
| String *tdname = Getattr(n, "tdname"); |
| String *kind = Getattr(n, "kind"); |
| String *type; |
| |
| if(Len(tdname)) { |
| type = Copy(tdname); |
| } else { |
| type = NewStringf("%s %s", kind, name); |
| } |
| |
| String *mangledName = SwigType_manglestr(name); |
| |
| if (debugMode) |
| Printf(stdout, "generateCopyRoutines: name = %s, %s\n", name, type); |
| |
| Printf(copyToR->def, "CopyToR%s = function(value, obj = new(\"%s\"))\n{\n", |
| mangledName, name); |
| Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n", |
| mangledName); |
| |
| Node *c = firstChild(n); |
| |
| for(; c; c = nextSibling(c)) { |
| String *elName = Getattr(c, "name"); |
| if (!Len(elName)) { |
| continue; |
| } |
| String *elKind = Getattr(c, "kind"); |
| if (!Equal(elKind, "variable")) { |
| continue; |
| } |
| |
| String *tp = Swig_typemap_lookup("rtype", c, "", 0); |
| if(!tp) { |
| continue; |
| } |
| if (Strstr(tp, "R_class")) { |
| continue; |
| } |
| if (Strcmp(tp, "character") && |
| Strstr(Getattr(c, "decl"), "p.")) { |
| continue; |
| } |
| |
| |
| /* The S functions to get and set the member value. */ |
| String *elNameT = replaceInitialDash(elName); |
| Printf(copyToR->code, "obj@%s = value$%s;\n", elNameT, elNameT); |
| Printf(copyToC->code, "obj$%s = value@%s;\n", elNameT, elNameT); |
| Delete(elNameT); |
| } |
| Printf(copyToR->code, "obj;\n}\n\n"); |
| String *rclassName = getRClassNameCopyStruct(type, 0); // without the Ref. |
| Printf(sfile, "# Start definition of copy functions & methods for %s\n", rclassName); |
| |
| Wrapper_print(copyToR, sfile); |
| Printf(copyToC->code, "obj\n}\n\n"); |
| Wrapper_print(copyToC, sfile); |
| |
| |
| Printf(sfile, "# Start definition of copy methods for %s\n", rclassName); |
| Printf(sfile, "setMethod('copyToR', '_p_%s', CopyToR%s);\n", rclassName, |
| mangledName); |
| Printf(sfile, "setMethod('copyToC', '%s', CopyToC%s);\n\n", rclassName, |
| mangledName); |
| |
| Printf(sfile, "# End definition of copy methods for %s\n", rclassName); |
| Printf(sfile, "# End definition of copy functions & methods for %s\n", rclassName); |
| |
| String *m = NewStringf("%sCopyToR", name); |
| addNamespaceMethod(m); |
| char *tt = Char(m); tt[Len(m)-1] = 'C'; |
| addNamespaceMethod(m); |
| Delete(m); |
| Delete(rclassName); |
| Delete(mangledName); |
| DelWrapper(copyToR); |
| DelWrapper(copyToC); |
| |
| return SWIG_OK; |
| } |
| |
| |
| |
| /* ------------------------------------------------------------- |
| * Called when there is a typedef to be invoked. |
| * |
| * XXX Needs to be enhanced or split to handle the case where we have a |
| * typedef within a classDeclaration emission because the struct/union/etc. |
| * is anonymous. |
| * --------------------------------------------------------------*/ |
| |
| int R::typedefHandler(Node *n) { |
| SwigType *tp = Getattr(n, "type"); |
| String *type = Getattr(n, "type"); |
| if (debugMode) |
| Printf(stdout, "<typedefHandler> %s\n", Getattr(n, "name")); |
| |
| processType(tp, n); |
| |
| if(Strncmp(type, "struct ", 7) == 0) { |
| String *name = Getattr(n, "name"); |
| char *trueName = Char(type); |
| trueName += 7; |
| if (debugMode) |
| Printf(stdout, "<typedefHandler> Defining S class %s\n", trueName); |
| Printf(s_classes, "setClass('_p%s', contains = 'ExternalReference')\n", |
| SwigType_manglestr(name)); |
| } |
| |
| return Language::typedefHandler(n); |
| } |
| |
| |
| |
| /* -------------------------------------------------------------- |
| * Called when processing a field in a "class", i.e. struct, union or |
| * actual class. We set a state variable so that we can correctly |
| * interpret the resulting functionWrapper() call and understand that |
| * it is for a field element. |
| * --------------------------------------------------------------*/ |
| |
| int R::membervariableHandler(Node *n) { |
| SwigType *t = Getattr(n, "type"); |
| processType(t, n, NULL); |
| processing_member_access_function = 1; |
| member_name = Getattr(n,"sym:name"); |
| if (debugMode) |
| Printf(stdout, "<membervariableHandler> name = %s, sym:name = %s\n", |
| Getattr(n, "name"), member_name); |
| |
| int status(Language::membervariableHandler(n)); |
| |
| if(!opaqueClassDeclaration && debugMode) |
| Printf(stdout, "<membervariableHandler> %s %s\n", Getattr(n, "name"), Getattr(n, "type")); |
| |
| processing_member_access_function = 0; |
| member_name = NULL; |
| |
| return status; |
| } |
| |
| |
| /* |
| This doesn't seem to get used so leave it out for the moment. |
| */ |
| String * R::runtimeCode() { |
| String *s = Swig_include_sys("rrun.swg"); |
| if (!s) { |
| Printf(stdout, "*** Unable to open 'rrun.swg'\n"); |
| s = NewString(""); |
| } |
| return s; |
| } |
| |
| |
| /* ----------------------------------------------------------------------- |
| * Called when SWIG wants to initialize this |
| * We initialize anythin we want here. |
| * Most importantly, tell SWIG where to find the files (e.g. r.swg) for this module. |
| * Use Swig_mark_arg() to tell SWIG that it is understood and not to |
| * throw an error. |
| * --------------------------------------------------------------*/ |
| |
| void R::main(int argc, char *argv[]) { |
| init(); |
| Preprocessor_define("SWIGR 1", 0); |
| SWIG_library_directory("r"); |
| SWIG_config_file("r.swg"); |
| debugMode = false; |
| copyStruct = true; |
| memoryProfile = false; |
| aggressiveGc = false; |
| inCPlusMode = false; |
| outputNamespaceInfo = false; |
| noInitializationCode = false; |
| |
| this->Argc = argc; |
| this->Argv = argv; |
| |
| allow_overloading();// can we support this? |
| |
| for(int i = 0; i < argc; i++) { |
| if(strcmp(argv[i], "-package") == 0) { |
| Swig_mark_arg(i); |
| i++; |
| Swig_mark_arg(i); |
| Rpackage = argv[i]; |
| } else if(strcmp(argv[i], "-dll") == 0) { |
| Swig_mark_arg(i); |
| i++; |
| Swig_mark_arg(i); |
| DllName = argv[i]; |
| } else if(strcmp(argv[i], "-help") == 0) { |
| showUsage(); |
| } else if(strcmp(argv[i], "-namespace") == 0) { |
| outputNamespaceInfo = true; |
| Swig_mark_arg(i); |
| } else if(!strcmp(argv[i], "-no-init-code")) { |
| noInitializationCode = true; |
| Swig_mark_arg(i); |
| } else if(!strcmp(argv[i], "-c++")) { |
| inCPlusMode = true; |
| Swig_mark_arg(i); |
| Printf(s_classes, "setClass('C++Reference', contains = 'ExternalReference')\n"); |
| } else if(!strcmp(argv[i], "-debug")) { |
| debugMode = true; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i],"-copystruct")) { |
| copyStruct = true; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i], "-nocopystruct")) { |
| copyStruct = false; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i], "-memoryprof")) { |
| memoryProfile = true; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i], "-nomemoryprof")) { |
| memoryProfile = false; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i], "-aggressivegc")) { |
| aggressiveGc = true; |
| Swig_mark_arg(i); |
| } else if (!strcmp(argv[i], "-noaggressivegc")) { |
| aggressiveGc = false; |
| Swig_mark_arg(i); |
| } else if (strcmp(argv[i], "-cppcast") == 0) { |
| Printf(stderr, "Deprecated command line option: %s. This option is now always on.\n", argv[i]); |
| Swig_mark_arg(i); |
| } else if (strcmp(argv[i], "-nocppcast") == 0) { |
| Printf(stderr, "Deprecated command line option: %s. This option is no longer supported.\n", argv[i]); |
| Swig_mark_arg(i); |
| SWIG_exit(EXIT_FAILURE); |
| } |
| |
| if (debugMode) { |
| Swig_typemap_search_debug_set(); |
| Swig_typemap_used_debug_set(); |
| Swig_typemap_register_debug_set(); |
| Swig_file_debug_set(); |
| } |
| /// copyToR copyToC functions. |
| |
| } |
| } |
| |
| /* ----------------------------------------------------------------------- |
| * Could make this work for String or File and then just store the resulting string |
| * rather than the collection of arguments and argc. |
| * ----------------------------------------------------------------------- */ |
| int R::outputCommandLineArguments(File *out) |
| { |
| if(Argc < 1 || !Argv || !Argv[0]) |
| return(-1); |
| |
| Printf(out, "\n## Generated via the command line invocation:\n##\t"); |
| for(int i = 0; i < Argc ; i++) { |
| Printf(out, " %s", Argv[i]); |
| } |
| Printf(out, "\n\n\n"); |
| |
| return Argc; |
| } |
| |
| |
| |
| /* How SWIG instantiates an object from this module. |
| See swigmain.cxx */ |
| extern "C" |
| Language *swig_r(void) { |
| return new R(); |
| } |
| |
| |
| |
| |
| /* ----------------------------------------------------------------------- |
| * Needs to be reworked. |
| *----------------------------------------------------------------------- */ |
| String * R::processType(SwigType *t, Node *n, int *nargs) { |
| //XXX Need to handle typedefs, e.g. |
| // a type which is a typedef to a function pointer. |
| |
| SwigType *tmp = Getattr(n, "tdname"); |
| if (debugMode) |
| Printf(stdout, "processType %s (tdname = %s)(SwigType = %s)\n", Getattr(n, "name"), tmp, Copy(t)); |
| |
| SwigType *td = t; |
| if (expandTypedef(t) && |
| SwigType_istypedef(t)) { |
| SwigType *resolved = |
| SwigType_typedef_resolve_all(t); |
| if (expandTypedef(resolved)) { |
| td = Copy(resolved); |
| } |
| } |
| |
| if(!td) { |
| int count = 0; |
| String *b = getRTypeName(t, &count); |
| if(count && b && !Getattr(SClassDefs, b)) { |
| if (debugMode) |
| Printf(stdout, "<processType> Defining class %s\n", b); |
| |
| Printf(s_classes, "setClass('%s', contains = 'ExternalReference')\n", b); |
| Setattr(SClassDefs, b, b); |
| } |
| |
| } |
| |
| |
| if(td) |
| t = td; |
| |
| if(SwigType_isfunctionpointer(t)) { |
| if (debugMode) |
| Printf(stdout, |
| "<processType> Defining pointer handler %s\n", t); |
| |
| String *tmp = createFunctionPointerHandler(t, n, nargs); |
| return tmp; |
| } |
| |
| return NULL; |
| } |
| |
| |
| /* ----------------------------------------------------------------------- |
| * enumValue() |
| * This method will return a string with an enum value to use in from R when |
| * setting up an enum variable |
| * ------------------------------------------------------------------------ */ |
| |
| String *R::enumValue(Node *n) { |
| String *symname = Getattr(n, "sym:name"); |
| String *value = Getattr(n, "value"); |
| String *newsymname = 0; |
| |
| Node *parent = parentNode(n); |
| symname = Getattr(n, "sym:name"); |
| |
| // parent enumtype has namespace mangled in |
| String *etype = Getattr(parent, "enumtype"); |
| // we have to directly call the c wrapper function, as the |
| // R wrapper to the enum is designed to be used after the enum |
| // structures have been created on the R side. This means |
| // that we'll need to construct a .Call expression |
| |
| // change the type for variableWrapper |
| if (debugMode) { |
| Printf(stdout, "<enumValue> type set: %s\n", etype); |
| } |
| |
| Setattr(n, "type", etype); |
| |
| if (!getCurrentClass()) { |
| newsymname = Swig_name_member(0, Getattr(parent, "sym:name"), symname); |
| // Strange hack to change the name |
| Setattr(n, "name", Getattr(n, "value")); |
| Setattr(n, "sym:name", newsymname); |
| variableWrapper(n); |
| value = Swig_name_get(NSPACE_TODO, newsymname); |
| } else { |
| String *enumClassPrefix = getEnumClassPrefix(); |
| newsymname = Swig_name_member(0, enumClassPrefix, symname); |
| Setattr(n, "name", Getattr(n, "value")); |
| Setattr(n, "sym:name", newsymname); |
| variableWrapper(n); |
| value = Swig_name_get(NSPACE_TODO, newsymname); |
| } |
| value = Swig_name_wrapper(value); |
| Replace(value, "_wrap", "R_swig", DOH_REPLACE_FIRST); |
| |
| String *valuecall=NewString(""); |
| Printv(valuecall, ".Call('", value, "',FALSE, PACKAGE='", Rpackage, "')", NIL); |
| Delete(value); |
| return valuecall; |
| } |