This commit is contained in:
Joseph C Wang 2017-10-01 09:48:37 +08:00
commit f0acfcfb4b

View file

@ -12,6 +12,7 @@
* ----------------------------------------------------------------------------- */
#include "swigmod.h"
#include "cparse.h"
static const double DEFAULT_NUMBER = .0000123456712312312323;
@ -57,11 +58,11 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) {
return tmp;
/*
if(count)
if(count)
return(b);
Delete(b);
return(NewString(""));
Delete(b);
return(NewString(""));
*/
}
@ -90,7 +91,7 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
#ifdef R_SWIG_VERBOSE
if (debugMode)
Printf(stdout, "SwigType_split return an empty list for %s\n",
retType);
retType);
#endif
return(tmp);
}
@ -106,8 +107,8 @@ static String *getRClassName(String *retType, int /*addRef*/ = 1, int upRef=0) {
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");
Strncmp(Getitem(l, i), "a(", 2) == 0)
Printf(tmp, "Ref");
}
}
@ -211,14 +212,14 @@ R Options (available with -r)\n\
-cppcast - Enable C++ casting operators (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\
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\
(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\
invocations. Default is the module name.\n\
";
@ -291,6 +292,9 @@ public:
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",
@ -531,7 +535,7 @@ void R::addSMethodInfo(String *name, String *argType, int nargs) {
}
/*
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);
@ -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()");
@ -906,7 +910,7 @@ int R::DumpCode(Node *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);
@ -984,6 +988,7 @@ int R::OutputClassMemberTable(Hash *tb, File *out) {
/* 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(");
}
@ -1018,7 +1023,7 @@ int R::OutputClassMemberTable(Hash *tb, File *out) {
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.
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.
@ -1043,10 +1048,6 @@ 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];
@ -1054,6 +1055,10 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
if (!strcmp(ptr, "get"))
varaccessor++;
if (Getattr(itemList, item))
continue;
Setattr(itemList, item, "1");
String *pitem;
if (!Strcmp(item, "operator ()")) {
pitem = NewString("call");
@ -1312,6 +1317,260 @@ 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");
@ -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");
}
@ -1570,8 +1829,16 @@ int R::functionWrapper(Node *n) {
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);
@ -1872,6 +2139,15 @@ 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);
}
@ -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);
@ -2066,8 +2348,32 @@ void R::registerClass(Node *n) {
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) {
@ -2537,17 +2843,4 @@ String * R::processType(SwigType *t, Node *n, int *nargs) {
return NULL;
}
/*************************************************************************************/