diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx index db94ec934..421be3c3a 100644 --- a/Source/Modules/r.cxx +++ b/Source/Modules/r.cxx @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * This file is part of SWIG, which is licensed as a whole under version 3 + * 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 @@ -12,6 +12,7 @@ * ----------------------------------------------------------------------------- */ #include "swigmod.h" +#include "cparse.h" static const double DEFAULT_NUMBER = .0000123456712312312323; @@ -32,15 +33,15 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) { List *els = SwigType_split(t); int count = 0; int i; - - if(Strncmp(b, "struct ", 7) == 0) + + if(Strncmp(b, "struct ", 7) == 0) Replace(b, "struct ", "", DOH_REPLACE_FIRST); - + /* Printf(stdout, " %s,base = %s\n", t, b); - for(i = 0; i < Len(els); i++) + for(i = 0; i < Len(els); i++) Printf(stdout, "%d) %s, ", i, Getitem(els,i)); Printf(stdout, "\n"); */ - + for(i = 0; i < Len(els); i++) { String *el = Getitem(els, i); if(Strcmp(el, "p.") == 0 || Strncmp(el, "a(", 2) == 0) { @@ -50,18 +51,18 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) { } if(outCount) *outCount = count; - + String *tmp = NewString(""); char *retName = Char(SwigType_manglestr(t)); Insert(tmp, 0, retName); return tmp; - + /* - if(count) + if(count) return(b); - - Delete(b); - return(NewString("")); + + Delete(b); + return(NewString("")); */ } @@ -80,7 +81,7 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) { } else{ Insert(tmp, 0, retName); } - + return tmp; /* #if 1 @@ -89,33 +90,33 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) { if(!l || n == 0) { #ifdef R_SWIG_VERBOSE if (debugMode) - Printf(stdout, "SwigType_split return an empty list for %s\n", - retType); + 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"); + if(Strcmp(Getitem(l, i), "p.") == 0 || + Strncmp(Getitem(l, i), "a(", 2) == 0) + Printf(tmp, "Ref"); } } - + #else char *retName = Char(SwigType_manglestr(retType)); if(!retName) return(tmp); - + if(addRef) { while(retName && strlen(retName) > 1 && strncmp(retName, "_p", 2) == 0) { retName += 2; @@ -126,7 +127,7 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) { retName ++; Insert(tmp, 0, retName); #endif - + return tmp; */ } @@ -139,7 +140,7 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) { static String * getRClassNameCopyStruct(String *retType, int addRef) { String *tmp = NewString(""); - + #if 1 List *l = SwigType_split(retType); int n = Len(l); @@ -149,36 +150,36 @@ static String * getRClassNameCopyStruct(String *retType, int addRef) { #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 || + if(Strcmp(Getitem(l, i), "p.") == 0 || Strncmp(Getitem(l, i), "a(", 2) == 0) Printf(tmp, "Ref"); } } - + #else char *retName = Char(SwigType_manglestr(retType)); if(!retName) return(tmp); - + if(addRef) { - while(retName && strlen(retName) > 1 && + while(retName && strlen(retName) > 1 && strncmp(retName, "_p", 2) == 0) { retName += 2; Printf(tmp, "Ref"); } } - + if(retName[0] == '_') retName ++; Insert(tmp, 0, retName); @@ -197,10 +198,10 @@ static String * getRClassNameCopyStruct(String *retType, int addRef) { 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), + for(i = 0; i < n; i++) + Printf(out, "%s%s%s%s%s\n", tab8, + quote ? "\"" :"", + Getitem(l, i), quote ? "\"" :"", i < n-1 ? "," : ""); } @@ -211,14 +212,14 @@ R Options (available with -r)\n\ -cppcast - Enable C++ casting operators (default) \n\ -debug - Output debug\n\ -dll - Name of the DLL (without the .dll or .so suffix).\n\ - Default is the module name.\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_ code\n\ - (registration information still generated)\n\ + (registration information still generated)\n\ -package - Package name for the PACKAGE argument of the R .Call()\n\ - invocations. Default is the module name.\n\ + invocations. Default is the module name.\n\ "; @@ -278,7 +279,7 @@ public: 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); @@ -291,50 +292,53 @@ public: int typedefHandler(Node *n); + static List *Swig_overload_rank(Node *n, + bool script_lang_wrapping); + int memberfunctionHandler(Node *n) { if (debugMode) - Printf(stdout, " %s %s\n", + Printf(stdout, " %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); + 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 + /* 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) + 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 generateCopyRoutines(Node *n); int DumpCode(Node *n); - + int OutputMemberReferenceMethod(String *className, int isSet, List *el, File *out); int OutputArrayMethod(String *className, List *el, File *out); int OutputClassMemberTable(Hash *tb, File *out); int OutputClassMethodsTable(File *out); int OutputClassAccessInfo(Hash *tb, File *out); - + int defineArrayAccessors(SwigType *type); - + void addNamespaceFunction(String *name) { if(!namespaceFunctions) namespaceFunctions = NewList(); @@ -346,41 +350,41 @@ protected: 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) + if(!functionPointerProxyTable) functionPointerProxyTable = NewHash(); - + Setattr(functionPointerProxyTable, name, n); - + Setattr(SClassDefs, name, name); - Printv(s_classes, "setClass('", + Printv(s_classes, "setClass('", name, - "',\n", tab8, + "',\n", tab8, "prototype = list(parameterTypes = c(", s_paramTypes, "),\n", tab8, tab8, tab8, - "returnType = '", SwigType_manglestr(t), "'),\n", tab8, + "returnType = '", SwigType_manglestr(t), "'),\n", tab8, "contains = 'CRoutinePointer')\n\n##\n", NIL); - + return SWIG_OK; } - - void addSMethodInfo(String *name, + + 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, + // Simple initialization such as constant strings that can be reused. + void init(); + + + void addAccessor(String *memberName, Wrapper *f, String *name, int isSet = -1); - + static int getFunctionPointerNumArgs(Node *n, SwigType *tt); -protected: +protected: bool copyStruct; bool memoryProfile; bool aggressiveGc; @@ -398,49 +402,49 @@ protected: 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. + + // 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; - - + + int processing_class_member_function; List *class_member_functions; List *class_member_set_functions; - + /* */ Hash *ClassMemberTable; Hash *ClassMethodsTable; Hash *SClassDefs; Hash *SMethodInfo; - - // Information about routines that are generated and to be registered with - // R for dynamic lookup. + + // 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. + + + // 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 @@ -506,7 +510,7 @@ int R::getFunctionPointerNumArgs(Node *n, SwigType *tt) { void R::addSMethodInfo(String *name, String *argType, int nargs) { (void) argType; - + if(!SMethodInfo) SMethodInfo = NewHash(); if (debugMode) @@ -529,20 +533,20 @@ void R::addSMethodInfo(String *name, String *argType, int nargs) { Setattr(tb, "max", str); } } - + /* -Returns the name of the new routine. + 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, " Defining %s\n", t); - + SwigType *rettype = Copy(Getattr(n, "type")); SwigType *funcparams = SwigType_functionpointer_decompose(rettype); String *rtype = SwigType_str(rettype, 0); @@ -556,13 +560,13 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { 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; @@ -578,7 +582,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { 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); @@ -587,7 +591,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { emit_parameter_variables(parms, f); emit_return_variable(n, rettype, f); -// emit_attach_parmmaps(parms,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()"); @@ -607,9 +611,9 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *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"); @@ -638,35 +642,35 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { 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(", + + Printv(f->code, "r_swig_cb_data->retValue = R_tryEval(", "r_swig_cb_data->expr,", " R_GlobalEnv,", " &r_swig_cb_data->errorOccurred", - ");\n", + ");\n", NIL); - + Printv(f->code, "\n", "if(r_swig_cb_data->errorOccurred) {\n", "R_SWIG_popCallbackFunctionData(1);\n", @@ -675,11 +679,11 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { ")\");\n", "}\n", NIL); - - - + + + if(!isVoidType) { - /* Need to deal with the return type of the function pointer, not the function pointer itself. + /* 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? @@ -697,7 +701,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { } Delete(bbase); } - + Printv(f->code, "R_SWIG_popCallbackFunctionData(1);\n", NIL); Printv(f->code, "\n", UnProtectWrapupCode, NIL); @@ -708,40 +712,40 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) { } 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. + 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 + 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 = + 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(""); @@ -768,13 +772,13 @@ int R::cDeclaration(Node *n) { /** Method from Language that is called to start the entire - processing off, i.e. the generation of the code. + 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(!Rpackage) + if(!Rpackage) Rpackage = Copy(module); if(!DllName) DllName = Copy(module); @@ -802,7 +806,7 @@ int R::top(Node *n) { Printf(f_runtime, "\n\n#ifndef SWIGR\n#define SWIGR\n#endif\n\n"); - + Swig_banner_target_lang(s_init, "#"); outputCommandLineArguments(s_init); @@ -853,27 +857,27 @@ int R::top(Node *n) { ****************************************************/ 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); - + Delete(scode); String *outfile = Getattr(n,"outfile"); File *runtime = NewFile(outfile,"w", SWIG_output_files()); @@ -881,7 +885,7 @@ int R::DumpCode(Node *n) { FileErrorDisplay(outfile); SWIG_exit(EXIT_FAILURE); } - + Printf(runtime, "%s", f_begin); Printf(runtime, "%s\n", f_runtime); Printf(runtime, "%s\n", s_header); @@ -899,14 +903,14 @@ int R::DumpCode(Node *n) { 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(namespaceFunctions, ns, 1); + writeListByLine(namespaceMethods, ns, 1); Printf(ns, ")\n"); Delete(ns); Delete(s_namespace); @@ -918,7 +922,7 @@ int R::DumpCode(Node *n) { /* - We may need to do more.... so this is left as a + We may need to do more.... so this is left as a stub for the moment. */ int R::OutputClassAccessInfo(Hash *tb, File *out) { @@ -930,15 +934,15 @@ int R::OutputClassAccessInfo(Hash *tb, File *out) { /************************************************************************ Currently this just writes the information collected about the different methods of the C++ classes that have been processed - to the console. + 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); @@ -962,35 +966,36 @@ int R::OutputClassMethodsTable(File *) { /* - Iterate over the _set and <>_get + Iterate over the _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 _set and + The entries are indexed by _set and _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 _set and _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); @@ -1000,42 +1005,42 @@ int R::OutputClassMemberTable(Hash *tb, File *out) { isSet = strcmp(ptr, "_set") == 0; } - // OutputArrayMethod(className, el, out); + // OutputArrayMethod(className, el, out); OutputMemberReferenceMethod(className, isSet, el, out); - - if(outputNamespaceInfo) + + if(outputNamespaceInfo) Printf(s_namespace, "\"%s\"%s", className, i < n-1 ? "," : ""); } - if(n && outputNamespaceInfo) { + if(n && outputNamespaceInfo) { Printf(s_namespace, ")\n"); } - + return n; } /******************************************************************* - Write the methods for $ or $<- for accessing a member field in an + 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. + 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 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, +int R::OutputMemberReferenceMethod(String *className, int isSet, List *el, File *out) { int numMems = Len(el), j; int varaccessor = 0; - if (numMems == 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); @@ -1043,17 +1048,17 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, bool has_prev = false; for(j = 0; j < numMems; j+=3) { String *item = Getitem(el, j); - if (Getattr(itemList, item)) - continue; - Setattr(itemList, item, "1"); - String *dup = Getitem(el, j + 1); char *ptr = Char(dup); ptr = &ptr[Len(dup) - 3]; - + if (!strcmp(ptr, "get")) varaccessor++; + if (Getattr(itemList, item)) + continue; + Setattr(itemList, item, "1"); + String *pitem; if (!Strcmp(item, "operator ()")) { pitem = NewString("call"); @@ -1066,7 +1071,7 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, } else { pitem = Copy(item); } - if (has_prev) + if (has_prev) Printf(f->code, ", "); Printf(f->code, "'%s' = %s", pitem, dup); has_prev = true; @@ -1074,7 +1079,7 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, } Delete(itemList); Printf(f->code, ");\n"); - + if (!isSet && varaccessor > 0) { Printf(f->code, "%svaccessors = c(", tab8); int first = 1; @@ -1083,7 +1088,7 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, String *dup = Getitem(el, j + 1); char *ptr = Char(dup); ptr = &ptr[Len(dup) - 3]; - + if (!strcmp(ptr, "get")) { Printf(f->code, "%s'%s'", first ? "" : ", ", item); first = 0; @@ -1091,15 +1096,15 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, } Printf(f->code, ");\n"); } - - + + /* Printv(f->code, tab8, "idx = pmatch(name, names(accessorFuns))\n", tab8, "if(is.na(idx)) {\n", - tab8, tab4, + tab8, tab4, "stop(\"No ", (isSet ? "modifiable" : "accessible"), " field named \", name, \" in ", className, - ": fields are \", paste(names(accessorFuns), sep = \", \")", + ": fields are \", paste(names(accessorFuns), sep = \", \")", ")", "\n}\n", NIL); */ Printv(f->code, ";", tab8, "idx = pmatch(name, names(accessorFuns));\n", @@ -1121,67 +1126,67 @@ int R::OutputMemberReferenceMethod(String *className, int isSet, } } Printf(f->code, "}\n"); - - + + Printf(out, "# Start of accessor method for %s\n", className); Printf(out, "setMethod('$%s', '_p%s', ", - isSet ? "<-" : "", - getRClassName(className)); + isSet ? "<-" : "", + getRClassName(className)); Wrapper_print(f, out); Printf(out, ");\n"); - + if(isSet) { - Printf(out, "setMethod('[[<-', c('_p%s', 'character'),", - getRClassName(className)); + 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"); } - + DelWrapper(attr); DelWrapper(f); - + Printf(out, "# end of accessor method for %s\n", className); - + return SWIG_OK; } /******************************************************************* - Write the methods for [ or [<- for accessing a member field in an + 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) el - a list of length 2 * # accessible member elements + 1. - The first element is the name of the class. + 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::OutputArrayMethod(String *className, List *el, File *out) { int numMems = Len(el), j; - + if(!el || numMems == 0) return(0); - + Printf(out, "# start of array methods for %s\n", className); for(j = 0; j < numMems; j+=3) { String *item = Getitem(el, j); String *dup = Getitem(el, j + 1); if (!Strcmp(item, "__getitem__")) { - Printf(out, - "setMethod('[', '_p%s', function(x, i, j, ..., drop =TRUE) ", + Printf(out, + "setMethod('[', '_p%s', function(x, i, j, ..., drop =TRUE) ", getRClassName(className)); Printf(out, " sapply(i, function (n) %s(x, as.integer(n-1))))\n\n", dup); } if (!Strcmp(item, "__setitem__")) { - Printf(out, "setMethod('[<-', '_p%s', function(x, i, j, ..., value)", + Printf(out, "setMethod('[<-', '_p%s', function(x, i, j, ..., value)", getRClassName(className)); Printf(out, " sapply(1:length(i), function(n) %s(x, as.integer(i[n]-1), value[n])))\n\n", dup); } - + } - + Printf(out, "# end of array methods for %s\n", className); - + return SWIG_OK; } @@ -1197,9 +1202,9 @@ int R::enumDeclaration(Node *n) { String *name = Getattr(n, "name"); String *tdname = Getattr(n, "tdname"); - + /* Using name if tdname is empty. */ - + if(Len(tdname) == 0) tdname = name; @@ -1208,40 +1213,40 @@ int R::enumDeclaration(Node *n) { Language::enumDeclaration(n); return SWIG_OK; } - + String *mangled_tdname = SwigType_manglestr(tdname); String *scode = NewString(""); - - Printv(scode, "defineEnumeration('", mangled_tdname, "'", + + Printv(scode, "defineEnumeration('", mangled_tdname, "'", ",\n", tab8, tab8, tab4, ".values = c(\n", NIL); - + Node *c; int value = -1; // First number is zero for (c = firstChild(n); c; c = nextSibling(c)) { // const char *tag = Char(nodeType(c)); - // if (Strcmp(tag,"cdecl") == 0) { + // if (Strcmp(tag,"cdecl") == 0) { name = Getattr(c, "name"); String *val = Getattr(c, "enumvalue"); if(val && Char(val)) { int inval = (int) getNumber(val); - if(inval == DEFAULT_NUMBER) + if(inval == DEFAULT_NUMBER) value++; - else + else value = inval; } else value++; - + Printf(scode, "%s%s%s'%s' = %d%s\n", tab8, tab8, tab8, name, value, nextSibling(c) ? ", " : ""); // } } - + Printv(scode, "))", NIL); Printf(sfile, "%s\n", scode); - + Delete(scode); Delete(mangled_tdname); - + return SWIG_OK; } @@ -1250,27 +1255,27 @@ int R::enumDeclaration(Node *n) { **************************************************************/ int R::variableWrapper(Node *n) { String *name = Getattr(n, "sym:name"); - + processing_variable = 1; Language::variableWrapper(n); // Force the emission of the _set and _get function wrappers. processing_variable = 0; - - + + SwigType *ty = Getattr(n, "type"); int addCopyParam = addCopyParameter(ty); - + //XXX processType(ty, n); - + if(!SwigType_isconst(ty)) { Wrapper *f = NewWrapper(); - Printf(f->def, "%s = \nfunction(value%s)\n{\n", + Printf(f->def, "%s = \nfunction(value%s)\n{\n", name, addCopyParam ? ", .copy = FALSE" : ""); - Printv(f->code, "if(missing(value)) {\n", + Printv(f->code, "if(missing(value)) {\n", name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL); - Printv(f->code, " else {\n", + Printv(f->code, " else {\n", name, "_set(value)\n}\n}", NIL); - + Wrapper_print(f, sfile); DelWrapper(f); } else { @@ -1281,7 +1286,7 @@ int R::variableWrapper(Node *n) { } -void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, +void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, int isSet) { if(isSet < 0) { int n = Len(name); @@ -1290,9 +1295,9 @@ void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, isSet = Strcmp(NewString(&ptr[n-4]), "_set") == 0; } } - + List *l = isSet ? class_member_set_functions : class_member_functions; - + if(!l) { l = NewList(); if(isSet) @@ -1300,10 +1305,10 @@ void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, else class_member_functions = l; } - + Append(l, memberName); Append(l, name); - + String *tmp = NewString(""); Wrapper_print(wrapper, tmp); Append(l, tmp); @@ -1312,11 +1317,265 @@ void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, 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; + } + /* if (SmartPointer && Getattr(c,"cplus:staticbase")) { + 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")); + bool constructor = (!Cmp(nodeType, "constructor")); String *sfname = NewString(symname); @@ -1330,7 +1589,7 @@ void R::dispatchFunction(Node *n) { } List *dispatch = Swig_overload_rank(n, true); int nfunc = Len(dispatch); - Printv(f->code, + Printv(f->code, "argtypes <- mapply(class, list(...));\n", "argv <- list(...);\n", "argc <- length(argtypes);\n", NIL ); @@ -1343,7 +1602,7 @@ void R::dispatchFunction(Node *n) { Parm *pi = Getattr(ni,"wrap:parms"); int num_arguments = emit_num_arguments(pi); - String *overname = Getattr(ni,"sym:overname"); + String *overname = Getattr(ni,"sym:overname"); if (cur_args != num_arguments) { if (cur_args != -1) { Printv(f->code, "} else ", NIL); @@ -1392,29 +1651,29 @@ void R::dispatchFunction(Node *n) { if (tm) { if (Strcmp(tm,"numeric")==0) { Printf(f->code, "%sis.numeric(argv[[%d]])", - j == 0 ? "" : " && ", - j+1); + j == 0 ? "" : " && ", + j+1); } else if (Strcmp(tm,"integer")==0) { Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", - j == 0 ? "" : " && ", - j+1, j+1); + j == 0 ? "" : " && ", + j+1, j+1); } else if (Strcmp(tm,"character")==0) { Printf(f->code, "%sis.character(argv[[%d]])", - j == 0 ? "" : " && ", - j+1); + j == 0 ? "" : " && ", + j+1); } else { Printf(f->code, "%sextends(argtypes[%d], '%s')", - j == 0 ? "" : " && ", - j+1, - tm); + j == 0 ? "" : " && ", + j+1, + tm); } } if (!SwigType_ispointer(Getattr(p, "type"))) { Printf(f->code, " && length(argv[[%d]]) == 1", - j+1); + j+1); } p = Getattr(p, "tmap:in:next"); } @@ -1442,40 +1701,40 @@ void R::dispatchFunction(Node *n) { int R::functionWrapper(Node *n) { String *fname = Getattr(n, "name"); String *iname = Getattr(n, "sym:name"); - String *type = Getattr(n, "type"); - + String *type = Getattr(n, "type"); + if (debugMode) { - Printf(stdout, + Printf(stdout, " %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")); - + 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"); + overname = Getattr(n,"sym:overname"); Append(sfname, overname); } - - if (debugMode) - Printf(stdout, + + if (debugMode) + Printf(stdout, " processing parameters\n"); - - + + ParmList *l = Getattr(n, "parms"); Parm *p; String *tm; - + p = l; while(p) { SwigType *resultType = Getattr(p, "type"); - if (expandTypedef(resultType) && + if (expandTypedef(resultType) && SwigType_istypedef(resultType)) { SwigType *resolved = SwigType_typedef_resolve_all(resultType); @@ -1484,43 +1743,43 @@ int R::functionWrapper(Node *n) { } } p = nextSibling(p); - } + } - String *unresolved_return_type = + String *unresolved_return_type = Copy(type); if (expandTypedef(type) && SwigType_istypedef(type)) { - SwigType *resolved = + SwigType *resolved = SwigType_typedef_resolve_all(type); if (expandTypedef(resolved)) { type = Copy(resolved); Setattr(n, "type", type); } } - if (debugMode) + if (debugMode) Printf(stdout, " unresolved_return_type %s\n", unresolved_return_type); if(processing_member_access_function) { if (debugMode) - Printf(stdout, " '%s' '%s' '%s' '%s'\n", + Printf(stdout, " '%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. + + + /* Add the name of this member to a list for this class_name. We will dump all these at the end. */ - + int n = Len(iname); char *ptr = Char(iname); bool isSet(0); if (n > 4) isSet = Strcmp(NewString(&ptr[n-4]), "_set") == 0; - - + + String *tmp = NewString(""); Printf(tmp, "%s_%s", class_name, isSet ? "set" : "get"); - + List *memList = Getattr(ClassMemberTable, tmp); if(!memList) { memList = NewList(); @@ -1531,29 +1790,29 @@ int R::functionWrapper(Node *n) { Append(memList, member_name); Append(memList, iname); } - + int i; int nargs; - + String *wname = Swig_name_wrapper(iname); Replace(wname, "_wrap", "R_swig", DOH_REPLACE_FIRST); - if(overname) + 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 + // 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) + if(!isVoidReturnType) addCopyParam = addCopyParameter(rtype); @@ -1562,16 +1821,24 @@ int R::functionWrapper(Node *n) { // if(addCopyParam) if (debugMode) - Printf(stdout, "Adding a .copy argument to %s for %s = %s\n", + 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); + 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 - addNamespaceFunction(iname); + 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); @@ -1633,7 +1900,7 @@ int R::functionWrapper(Node *n) { name = Copy(name); Insert(name, 0, "s_"); } - + if(processing_variable) { name = Copy(name); Insert(name, 0, "s_"); @@ -1658,7 +1925,7 @@ int R::functionWrapper(Node *n) { String *snargs = NewStringf("%d", nargs); Printv(sfun->code, "if(is.function(", name, ")) {", "\n", - "assert('...' %in% names(formals(", name, + "assert('...' %in% names(formals(", name, ")) || length(formals(", name, ")) >= ", snargs, ");\n} ", NIL); Delete(snargs); @@ -1713,11 +1980,11 @@ int R::functionWrapper(Node *n) { Printf(f->code,"%s\n",tm); - if(funcptr_name) - Printf(f->code, "} else {\n%s = %s;\nR_SWIG_pushCallbackFunctionData(%s, NULL);\n}\n", + 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) + if (Len(name) != 0) inFirstArg = false; p = Getattr(p,"tmap:in:next"); @@ -1734,7 +2001,7 @@ int R::functionWrapper(Node *n) { Printf(s_inputMap, "%s%s='%s'", inFirstType ? "" : ", ", name, tm); inFirstType = false; - if(funcptr_name) + if(funcptr_name) Delete(funcptr_name); } /* end of looping over parameters. */ @@ -1785,9 +2052,9 @@ int R::functionWrapper(Node *n) { String *actioncode = emit_action(n); /* Deal with the explicit return value. */ - if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) { + if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) { SwigType *retType = Getattr(n, "type"); - //Printf(stdout, "Return Value for %s, array? %s\n", retType, SwigType_isarray(retType) ? "yes" : "no"); + //Printf(stdout, "Return Value for %s, array? %s\n", retType, SwigType_isarray(retType) ? "yes" : "no"); /* if(SwigType_isarray(retType)) { defineArrayAccessors(retType); } */ @@ -1808,11 +2075,11 @@ int R::functionWrapper(Node *n) { Printf(f->code, "if(LOGICAL(s_swig_copy)[0]) {\n"); Printf(f->code, "/* Deal with returning a reference. */\nr_ans = R_NilValue;\n"); Printf(f->code, "}\n else {\n"); - } + } #endif Printf(f->code, "%s\n", tm); #if 0 - if(addCopyParam) + if(addCopyParam) Printf(f->code, "}\n"); /* end of if(s_swig_copy) ... else { ... } */ #endif @@ -1829,8 +2096,8 @@ int R::functionWrapper(Node *n) { 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, + Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n", + numOutArgs + !isVoidReturnType, isVoidReturnType ? 1 : 2); if(!isVoidReturnType) @@ -1838,7 +2105,7 @@ int R::functionWrapper(Node *n) { Printf(tmp, "r_ans = R_OutputValues;\n"); Insert(outargs, 0, tmp); - Delete(tmp); + Delete(tmp); @@ -1872,22 +2139,31 @@ int R::functionWrapper(Node *n) { 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); + } + } replaceRClass(tm, Getattr(n, "type")); Chop(tm); } - Printv(sfun->code, ";", (Len(tm) ? "ans = " : ""), ".Call('", wname, + Printv(sfun->code, ";", (Len(tm) ? "ans = " : ""), ".Call('", wname, "', ", sargs, "PACKAGE='", Rpackage, "');\n", NIL); if(Len(tm)) { - Printf(sfun->code, "%s\n\n", 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"); } @@ -1908,17 +2184,17 @@ int R::functionWrapper(Node *n) { if(tm) { SwigType *retType = Getattr(n, "type"); replaceRClass(tm, retType); - } - - Printv(sfile, "attr(`", sfname, "`, 'returnType') = '", - isVoidReturnType ? "void" : (tm ? tm : ""), - "'\n", NIL); - + } + + 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); + Printv(sfile, "class(`", sfname, "`) = c(\"SWIGFunction\", class('", + sfname, "'))\n\n", NIL); if (memoryProfile) { Printv(sfile, "memory.profile()\n", NIL); @@ -1931,8 +2207,8 @@ int R::functionWrapper(Node *n) { - /* If we are dealing with a method in an C++ class, then - add the name of the R function and its definition. + /* 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 */ @@ -1966,21 +2242,21 @@ int R::constantWrapper(Node *n) { } /***************************************************** - Add the specified routine name to the collection of + 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 + 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. + nargs - the number of arguments it expects. ******************************************************/ int R::addRegistrationRoutine(String *rname, int nargs) { - if(!registrationTable) + if(!registrationTable) registrationTable = NewHash(); - String *el = + String *el = NewStringf("{\"%s\", (DL_FUNC) &%s, %d}", rname, rname, nargs); - + Setattr(registrationTable, rname, el); return SWIG_OK; @@ -1993,17 +2269,17 @@ int R::addRegistrationRoutine(String *rname, int nargs) { ******************************************************/ int R::outputRegistrationRoutines(File *out) { int i, n; - if(!registrationTable) + if(!registrationTable) return(0); - if(inCPlusMode) + if(inCPlusMode) Printf(out, "#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n"); Printf(out, "#include \n\n"); - if(inCPlusMode) + 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++) @@ -2014,7 +2290,13 @@ int R::outputRegistrationRoutines(File *out) { if(!noInitializationCode) { if (inCPlusMode) Printv(out, "extern \"C\" ", NIL); - Printf(out, "SWIGEXPORT void R_init_%s(DllInfo *dll) {\n", Rpackage); + { /* 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); @@ -2030,14 +2312,14 @@ int R::outputRegistrationRoutines(File *out) { /**************************************************************************** Process a struct, union or class declaration in the source code, or an anonymous typedef struct - + *****************************************************************************/ -//XXX What do we need to do here - +//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"); + String *name = Getattr(n, "name"); + String *kind = Getattr(n, "kind"); if (debugMode) Swig_print_node(n); @@ -2053,33 +2335,57 @@ void R::registerClass(Node *n) { 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, "'_p%s'%s", + SwigType_manglestr(Getattr(Getitem(l, i), "name")), + i < Len(l)-1 ? ", " : ""); } Printf(base, ")"); } else { base = NewString("'C++Reference'"); } - } else + } 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"); + 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 @@ -2099,7 +2405,7 @@ int R::classDeclaration(Node *n) { opaqueClassDeclaration = NULL; - // OutputArrayMethod(name, class_member_functions, sfile); + // OutputArrayMethod(name, class_member_functions, sfile); if (class_member_functions) OutputMemberReferenceMethod(name, 0, class_member_functions, sfile); if (class_member_set_functions) @@ -2121,7 +2427,7 @@ int R::classDeclaration(Node *n) { } if(!opaque && !Strcmp(kind, "struct") && copyStruct) { - String *def = + String *def = NewStringf("setClass(\"%s\",\n%srepresentation(\n", name, tab4); bool firstItem = true; @@ -2130,7 +2436,7 @@ int R::classDeclaration(Node *n) { String *tp; elName = Getattr(c, "name"); - + String *elKind = Getattr(c, "kind"); if (!Equal(elKind, "variable")) { c = nextSibling(c); @@ -2160,12 +2466,12 @@ int R::classDeclaration(Node *n) { if (!firstItem) { Printf(def, ",\n"); - } - // else + } + // else //XXX How can we tell if this is already done. // SwigType_push(elType, elDecl); - - + + // returns "" tp = processType(elType, c, NULL); // Printf(stdout, " elType %p\n", elType); // tp = getRClassNameCopyStruct(Getattr(c, "type"), 1); @@ -2204,7 +2510,7 @@ int R::classDeclaration(Node *n) { 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"); @@ -2221,9 +2527,9 @@ int R::generateCopyRoutines(Node *n) { if (debugMode) Printf(stdout, "generateCopyRoutines: name = %s, %s\n", name, type); - Printf(copyToR->def, "CopyToR%s = function(value, obj = new(\"%s\"))\n{\n", + Printf(copyToR->def, "CopyToR%s = function(value, obj = new(\"%s\"))\n{\n", mangledName, name); - Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n", + Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n", mangledName); Node *c = firstChild(n); @@ -2259,22 +2565,22 @@ int R::generateCopyRoutines(Node *n) { } 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); - + 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, + + + 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, + 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); - + + 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'; @@ -2291,9 +2597,9 @@ int R::generateCopyRoutines(Node *n) { /***** - Called when there is a typedef to be invoked. + Called when there is a typedef to be invoked. - XXX Needs to be enhanced or split to handle the case where we have a + 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. ******/ @@ -2311,7 +2617,7 @@ int R::typedefHandler(Node *n) { trueName += 7; if (debugMode) Printf(stdout, " Defining S class %s\n", trueName); - Printf(s_classes, "setClass('_p%s', contains = 'ExternalReference')\n", + Printf(s_classes, "setClass('_p%s', contains = 'ExternalReference')\n", SwigType_manglestr(name)); } @@ -2323,7 +2629,7 @@ int R::typedefHandler(Node *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 + interpret the resulting functionWrapper() call and understand that it is for a field element. **********************/ int R::membervariableHandler(Node *n) { @@ -2332,7 +2638,7 @@ int R::membervariableHandler(Node *n) { processing_member_access_function = 1; member_name = Getattr(n,"sym:name"); if (debugMode) - Printf(stdout, " name = %s, sym:name = %s\n", + Printf(stdout, " name = %s, sym:name = %s\n", Getattr(n, "name"), member_name); int status(Language::membervariableHandler(n)); @@ -2361,7 +2667,7 @@ String * R::runtimeCode() { /** - Called when SWIG wants to initialize this + 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. @@ -2383,7 +2689,7 @@ void R::main(int argc, char *argv[]) { this->Argc = argc; this->Argv = argv; - allow_overloading();// can we support this? + allow_overloading();// can we support this? for(int i = 0; i < argc; i++) { if(strcmp(argv[i], "-package") == 0) { @@ -2472,9 +2778,9 @@ int R::outputCommandLineArguments(File *out) -/* How SWIG instantiates an object from this module. +/* How SWIG instantiates an object from this module. See swigmain.cxx */ -extern "C" +extern "C" Language *swig_r(void) { return new R(); } @@ -2493,11 +2799,11 @@ String * R::processType(SwigType *t, Node *n, int *nargs) { SwigType *tmp = Getattr(n, "tdname"); if (debugMode) Printf(stdout, "processType %s (tdname = %s)\n", Getattr(n, "name"), tmp); - + SwigType *td = t; if (expandTypedef(t) && SwigType_istypedef(t)) { - SwigType *resolved = + SwigType *resolved = SwigType_typedef_resolve_all(t); if (expandTypedef(resolved)) { td = Copy(resolved); @@ -2511,10 +2817,10 @@ String * R::processType(SwigType *t, Node *n, int *nargs) { if (debugMode) Printf(stdout, " Defining class %s\n", b); - Printf(s_classes, "setClass('%s', contains = 'ExternalReference')\n", b); + Printf(s_classes, "setClass('%s', contains = 'ExternalReference')\n", b); Setattr(SClassDefs, b, b); } - + } @@ -2523,9 +2829,9 @@ String * R::processType(SwigType *t, Node *n, int *nargs) { if(SwigType_isfunctionpointer(t)) { if (debugMode) - Printf(stdout, + Printf(stdout, " Defining pointer handler %s\n", t); - + String *tmp = createFunctionPointerHandler(t, n, nargs); return tmp; } @@ -2537,17 +2843,4 @@ String * R::processType(SwigType *t, Node *n, int *nargs) { return NULL; } - - - - - - - - /*************************************************************************************/ - - - - -