jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #494 from richardbeare/enumR2015B

Browse source 
replacement for enumR2015 - tidied and rebased
This commit is contained in:
joequant 2015-08-10 13:37:27 +08:00
commit cb8973f313
14 changed files with 1064 additions and 1057 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Examples/test-suite/r/Makefile.in
View file

@ -5,7 +5,7 @@
LANGUAGE = r LANGUAGE = r
SCRIPTSUFFIX = _runme.R SCRIPTSUFFIX = _runme.R
WRAPSUFFIX = .R WRAPSUFFIX = .R
RUNR = R CMD BATCH --no-save --no-restore RUNR = R CMD BATCH --no-save --no-restore '--args $(SCRIPTDIR)'
srcdir = @srcdir@ srcdir = @srcdir@
top_srcdir = @top_srcdir@ top_srcdir = @top_srcdir@
@ -44,6 +44,7 @@ include $(srcdir)/../common.mk
+$(swig_and_compile_multi_cpp) +$(swig_and_compile_multi_cpp)
$(run_multitestcase) $(run_multitestcase)
# Runs the testcase. # Runs the testcase.
# #
# Run the runme if it exists. If not just load the R wrapper to # Run the runme if it exists. If not just load the R wrapper to

4
Examples/test-suite/r/arrays_dimensionless_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("arrays_dimensionless", .Platform$dynlib.ext, sep="")) dyn.load(paste("arrays_dimensionless", .Platform$dynlib.ext, sep=""))
source("arrays_dimensionless.R") source("arrays_dimensionless.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/funcptr_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("funcptr", .Platform$dynlib.ext, sep="")) dyn.load(paste("funcptr", .Platform$dynlib.ext, sep=""))
source("funcptr.R") source("funcptr.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/ignore_parameter_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("ignore_parameter", .Platform$dynlib.ext, sep="")) dyn.load(paste("ignore_parameter", .Platform$dynlib.ext, sep=""))
source("ignore_parameter.R") source("ignore_parameter.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/integers_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("integers", .Platform$dynlib.ext, sep="")) dyn.load(paste("integers", .Platform$dynlib.ext, sep=""))
source("integers.R") source("integers.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/overload_method_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("overload_method", .Platform$dynlib.ext, sep="")) dyn.load(paste("overload_method", .Platform$dynlib.ext, sep=""))
source("overload_method.R") source("overload_method.R")
cacheMetaData(1) cacheMetaData(1)

11
Examples/test-suite/r/preproc_constants_runme.R Normal file
View file

@ -0,0 +1,11 @@
clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("preproc_constants", .Platform$dynlib.ext, sep=""))
source("preproc_constants.R")
cacheMetaData(1)
v <- enumToInteger('kValue', '_MyEnum')
print(v)
unittest(v,4)
q(save="no")

4
Examples/test-suite/r/r_copy_struct_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("r_copy_struct", .Platform$dynlib.ext, sep="")) dyn.load(paste("r_copy_struct", .Platform$dynlib.ext, sep=""))
source("r_copy_struct.R") source("r_copy_struct.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/r_legacy_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("r_legacy", .Platform$dynlib.ext, sep="")) dyn.load(paste("r_legacy", .Platform$dynlib.ext, sep=""))
source("r_legacy.R") source("r_legacy.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/r_sexp_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("r_sexp", .Platform$dynlib.ext, sep="")) dyn.load(paste("r_sexp", .Platform$dynlib.ext, sep=""))
source("r_sexp.R") source("r_sexp.R")
cacheMetaData(1) cacheMetaData(1)

4
Examples/test-suite/r/rename_simple_runme.R
View file

@ -1,4 +1,6 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("rename_simple", .Platform$dynlib.ext, sep="")) dyn.load(paste("rename_simple", .Platform$dynlib.ext, sep=""))
source("rename_simple.R") source("rename_simple.R")
cacheMetaData(1) cacheMetaData(1)

3
Examples/test-suite/r/simple_array_runme.R
View file

@ -1,4 +1,5 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("simple_array", .Platform$dynlib.ext, sep="")) dyn.load(paste("simple_array", .Platform$dynlib.ext, sep=""))
source("simple_array.R") source("simple_array.R")
cacheMetaData(1) cacheMetaData(1)

3
Examples/test-suite/r/unions_runme.R
View file

@ -1,4 +1,5 @@
source("unittest.R") clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("unions", .Platform$dynlib.ext, sep="")) dyn.load(paste("unions", .Platform$dynlib.ext, sep=""))
source("unions.R") source("unions.R")
cacheMetaData(1) cacheMetaData(1)

455
Source/Modules/r.cxx
View file

@ -12,11 +12,11 @@
* ----------------------------------------------------------------------------- */ * ----------------------------------------------------------------------------- */
#include "swigmod.h" #include "swigmod.h"
#include <limits.h>
static const double DEFAULT_NUMBER = .0000123456712312312323; static const double DEFAULT_NUMBER = .0000123456712312312323;
static String* replaceInitialDash(const String *name) static String *replaceInitialDash(const String *name) {
{
String *retval; String *retval;
if (!Strncmp(name, "_", 1)) { if (!Strncmp(name, "_", 1)) {
retval = Copy(name); retval = Copy(name);
@ -65,6 +65,21 @@ static String * getRTypeName(SwigType *t, int *outCount = NULL) {
*/ */
} }
static String *getNamespacePrefix(const String *enumRef) {
// for use from enumDeclaration.
// returns the namespace part of a string
// Do we have any "::"?
String *name = NewString(enumRef);
while (Strstr(name, "::")) {
name = NewStringf("%s", Strchr(name, ':') + 2);
}
String *result = NewStringWithSize(enumRef, Len(enumRef) - Len(name));
Delete(name);
return (result);
}
/********************* /*********************
Tries to get the name of the R class corresponding to the given type Tries to get the name of the R class corresponding to the given type
e.g. struct A * is ARef, struct A** is ARefRef. e.g. struct A * is ARef, struct A** is ARefRef.
@ -160,20 +175,17 @@ static String * getRClassNameCopyStruct(String *retType, int addRef) {
if (addRef) { if (addRef) {
for (int i = 0; i < n; i++) { 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)
Strncmp(Getitem(l, i), "a(", 2) == 0)
Printf(tmp, "Ref"); Printf(tmp, "Ref");
} }
} }
#else #else
char *retName = Char(SwigType_manglestr(retType)); char *retName = Char(SwigType_manglestr(retType));
if (!retName) if (!retName)
return (tmp); return (tmp);
if (addRef) { if (addRef) {
while(retName && strlen(retName) > 1 && while (retName && strlen(retName) > 1 && strncmp(retName, "_p", 2) == 0) {
strncmp(retName, "_p", 2) == 0) {
retName += 2; retName += 2;
Printf(tmp, "Ref"); Printf(tmp, "Ref");
} }
@ -198,10 +210,7 @@ static String * getRClassNameCopyStruct(String *retType, int addRef) {
static void writeListByLine(List *l, File *out, bool quote = 0) { static void writeListByLine(List *l, File *out, bool quote = 0) {
int i, n = Len(l); int i, n = Len(l);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
Printf(out, "%s%s%s%s%s\n", tab8, Printf(out, "%s%s%s%s%s\n", tab8, quote ? "\"" : "", Getitem(l, i), quote ? "\"" : "", i < n - 1 ? "," : "");
quote ? "\"" :"",
Getitem(l, i),
quote ? "\"" :"", i < n-1 ? "," : "");
} }
@ -231,10 +240,13 @@ static void showUsage() {
} }
static bool expandTypedef(SwigType *t) { static bool expandTypedef(SwigType *t) {
if (SwigType_isenum(t)) return false; if (SwigType_isenum(t))
return false;
String *prefix = SwigType_prefix(t); String *prefix = SwigType_prefix(t);
if (Strncmp(prefix, "f", 1)) return false; if (Strncmp(prefix, "f", 1))
if (Strncmp(prefix, "p.f", 3)) return false; return false;
if (Strncmp(prefix, "p.f", 3))
return false;
return true; return true;
} }
@ -260,7 +272,9 @@ static void replaceRClass(String *tm, SwigType *type) {
Replaceall(tm, "$R_class", tmp); Replaceall(tm, "$R_class", tmp);
Replaceall(tm, "$*R_class", tmp_base); Replaceall(tm, "$*R_class", tmp_base);
Replaceall(tm, "$&R_class", tmp_ref); Replaceall(tm, "$&R_class", tmp_ref);
Delete(tmp); Delete(tmp_base); Delete(tmp_ref); Delete(tmp);
Delete(tmp_base);
Delete(tmp_ref);
} }
static double getNumber(String *value) { static double getNumber(String *value) {
@ -272,6 +286,7 @@ static double getNumber(String *value) {
return (d); return (d);
} }
class R:public Language { class R:public Language {
public: public:
R(); R();
@ -290,24 +305,19 @@ public:
int membervariableHandler(Node *n); int membervariableHandler(Node *n);
int typedefHandler(Node *n); int typedefHandler(Node *n);
static List *Swig_overload_rank(Node *n, static List *Swig_overload_rank(Node *n, bool script_lang_wrapping);
bool script_lang_wrapping);
int memberfunctionHandler(Node *n) { int memberfunctionHandler(Node *n) {
if (debugMode) if (debugMode)
Printf(stdout, "<memberfunctionHandler> %s %s\n", Printf(stdout, "<memberfunctionHandler> %s %s\n", Getattr(n, "name"), Getattr(n, "type"));
Getattr(n, "name"),
Getattr(n, "type"));
member_name = Getattr(n, "sym:name"); member_name = Getattr(n, "sym:name");
processing_class_member_function = 1; processing_class_member_function = 1;
int status = Language::memberfunctionHandler(n); int status = Language::memberfunctionHandler(n);
processing_class_member_function = 0; processing_class_member_function = 0;
return status; 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. */ deal with members of that class. */ int classHandler(Node *n) {
int classHandler(Node *n){
if (!ClassMemberTable) if (!ClassMemberTable)
ClassMemberTable = NewHash(); ClassMemberTable = NewHash();
@ -363,22 +373,18 @@ protected:
name, name,
"',\n", tab8, "',\n", tab8,
"prototype = list(parameterTypes = c(", s_paramTypes, "),\n", "prototype = list(parameterTypes = c(", s_paramTypes, "),\n",
tab8, tab8, tab8, tab8, tab8, tab8, "returnType = '", SwigType_manglestr(t), "'),\n", tab8, "contains = 'CRoutinePointer')\n\n##\n", NIL);
"returnType = '", SwigType_manglestr(t), "'),\n", tab8,
"contains = 'CRoutinePointer')\n\n##\n", NIL);
return SWIG_OK; return SWIG_OK;
} }
void addSMethodInfo(String *name, void addSMethodInfo(String *name, String *argType, int nargs);
String *argType, int nargs);
// Simple initialization such as constant strings that can be reused. // Simple initialization such as constant strings that can be reused.
void init(); void init();
void addAccessor(String *memberName, Wrapper *f, void addAccessor(String *memberName, Wrapper *f, String *name, int isSet = -1);
String *name, int isSet = -1);
static int getFunctionPointerNumArgs(Node *n, SwigType *tt); static int getFunctionPointerNumArgs(Node *n, SwigType *tt);
@ -481,14 +487,7 @@ R::R() :
namespaceFunctions(0), namespaceFunctions(0),
namespaceMethods(0), namespaceMethods(0),
namespaceClasses(0), namespaceClasses(0),
Argv(0), Argv(0), Argc(0), inCPlusMode(false), DllName(0), Rpackage(0), noInitializationCode(false), outputNamespaceInfo(false), UnProtectWrapupCode(0) {
Argc(0),
inCPlusMode(false),
DllName(0),
Rpackage(0),
noInitializationCode(false),
outputNamespaceInfo(false),
UnProtectWrapupCode(0) {
} }
bool R::debugMode = false; bool R::debugMode = false;
@ -526,7 +525,8 @@ void R::addSMethodInfo(String *name, String *argType, int nargs) {
if (str) if (str)
max = atoi(Char(str)); max = atoi(Char(str));
if (max < nargs) { if (max < nargs) {
if(str) Delete(str); if (str)
Delete(str);
str = NewStringf("%d", max); str = NewStringf("%d", max);
Setattr(tb, "max", str); Setattr(tb, "max", str);
} }
@ -656,21 +656,11 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
Printf(f->code, "%s\n\n", setExprElements); 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", NIL);
"r_swig_cb_data->expr,",
" R_GlobalEnv,",
" &r_swig_cb_data->errorOccurred",
");\n",
NIL);
Printv(f->code, "\n", Printv(f->code, "\n",
"if(r_swig_cb_data->errorOccurred) {\n", "if(r_swig_cb_data->errorOccurred) {\n",
"R_SWIG_popCallbackFunctionData(1);\n", "R_SWIG_popCallbackFunctionData(1);\n", "Rf_error(\"error in calling R function as a function pointer (", funName, ")\");\n", "}\n", NIL);
"Rf_error(\"error in calling R function as a function pointer (",
funName,
")\");\n",
"}\n",
NIL);
@ -730,8 +720,7 @@ String * R::createFunctionPointerHandler(SwigType *t, Node *n, int *numArgs) {
} }
void R::init() { void R::init() {
UnProtectWrapupCode = UnProtectWrapupCode = NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect) Rf_unprotect(r_nprotect);\n\n");
NewStringf("%s", "vmaxset(r_vmax);\nif(r_nprotect) Rf_unprotect(r_nprotect);\n\n");
SClassDefs = NewHash(); SClassDefs = NewHash();
@ -1013,8 +1002,7 @@ int R::OutputClassMemberTable(Hash *tb, File *out) {
The other pairs are member name and the name of the R function to access it. The other pairs are member name and the name of the R function to access it.
out - the stream where we write the code. 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) {
List *el, File *out) {
int numMems = Len(el), j; int numMems = Len(el), j;
int varaccessor = 0; int varaccessor = 0;
if (numMems == 0) if (numMems == 0)
@ -1090,21 +1078,15 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
"stop(\"No ", (isSet ? "modifiable" : "accessible"), " field named \", name, \" in ", className, "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); */ ")", "\n}\n", NIL); */
Printv(f->code, ";", tab8, Printv(f->code, ";", tab8, "idx = pmatch(name, names(accessorFuns));\n", tab8, "if(is.na(idx)) \n", tab8, tab4, NIL);
"idx = pmatch(name, names(accessorFuns));\n", Printf(f->code, "return(callNextMethod(x, name%s));\n", isSet ? ", value" : "");
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); Printv(f->code, tab8, "f = accessorFuns[[idx]];\n", NIL);
if (isSet) { if (isSet) {
Printv(f->code, tab8, "f(x, value);\n", NIL); Printv(f->code, tab8, "f(x, value);\n", NIL);
Printv(f->code, tab8, "x;\n", NIL); // make certain to return the S value. Printv(f->code, tab8, "x;\n", NIL); // make certain to return the S value.
} else { } else {
if (varaccessor) { if (varaccessor) {
Printv(f->code, tab8, Printv(f->code, tab8, "if (is.na(match(name, vaccessors))) function(...){f(x, ...)} else f(x);\n", NIL);
"if (is.na(match(name, vaccessors))) function(...){f(x, ...)} else f(x);\n", NIL);
} else { } else {
Printv(f->code, tab8, "function(...){f(x, ...)};\n", NIL); Printv(f->code, tab8, "function(...){f(x, ...)};\n", NIL);
} }
@ -1113,15 +1095,12 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
Printf(out, "# Start of accessor method for %s\n", className); Printf(out, "# Start of accessor method for %s\n", className);
Printf(out, "setMethod('$%s', '_p%s', ", Printf(out, "setMethod('$%s', '_p%s', ", isSet ? "<-" : "", getRClassName(className));
isSet ? "<-" : "",
getRClassName(className));
Wrapper_print(f, out); Wrapper_print(f, out);
Printf(out, ");\n"); Printf(out, ");\n");
if (isSet) { if (isSet) {
Printf(out, "setMethod('[[<-', c('_p%s', 'character'),", Printf(out, "setMethod('[[<-', c('_p%s', 'character'),", getRClassName(className));
getRClassName(className));
Insert(f->code, 2, "name = i;\n"); Insert(f->code, 2, "name = i;\n");
Printf(attr->code, "%s", f->code); Printf(attr->code, "%s", f->code);
Wrapper_print(attr, out); Wrapper_print(attr, out);
@ -1156,14 +1135,11 @@ int R::OutputArrayMethod(String *className, List *el, File *out) {
String *item = Getitem(el, j); String *item = Getitem(el, j);
String *dup = Getitem(el, j + 1); String *dup = Getitem(el, j + 1);
if (!Strcmp(item, "__getitem__")) { if (!Strcmp(item, "__getitem__")) {
Printf(out, Printf(out, "setMethod('[', '_p%s', function(x, i, j, ..., drop =TRUE) ", getRClassName(className));
"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); Printf(out, " sapply(i, function (n) %s(x, as.integer(n-1))))\n\n", dup);
} }
if (!Strcmp(item, "__setitem__")) { 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));
getRClassName(className));
Printf(out, " sapply(1:length(i), function(n) %s(x, as.integer(i[n]-1), value[n])))\n\n", dup); Printf(out, " sapply(1:length(i), function(n) %s(x, as.integer(i[n]-1), value[n])))\n\n", dup);
} }
@ -1184,12 +1160,15 @@ int R::enumDeclaration(Node *n) {
String *name = Getattr(n, "name"); String *name = Getattr(n, "name");
String *tdname = Getattr(n, "tdname"); String *tdname = Getattr(n, "tdname");
if (cplus_mode != PUBLIC) {
return (SWIG_NOWRAP);
}
/* Using name if tdname is empty. */ /* Using name if tdname is empty. */
if (Len(tdname) == 0) if (Len(tdname) == 0)
tdname = name; tdname = name;
if (!tdname || Strcmp(tdname, "") == 0) { if (!tdname || Strcmp(tdname, "") == 0) {
Language::enumDeclaration(n); Language::enumDeclaration(n);
return SWIG_OK; return SWIG_OK;
@ -1197,37 +1176,112 @@ int R::enumDeclaration(Node *n) {
String *mangled_tdname = SwigType_manglestr(tdname); String *mangled_tdname = SwigType_manglestr(tdname);
String *scode = NewString(""); String *scode = NewString("");
String *possiblescode = NewString("");
Printv(scode, "defineEnumeration('", mangled_tdname, "'", // Need to create some C code to return the enum values.
",\n", tab8, tab8, tab4, ".values = c(\n", NIL); // Presumably a C function for each element of the enum..
// There is probably some sneaky way to use the
// standard methods of variable/constant access, but I can't see
// it yet.
// Need to fetch the namespace part of the enum in tdname, so
// that we can address the correct enum. Perhaps there is already an
// attribute that has this info, but I can't find it. That leaves
// searching for ::. Obviously needs to work if there is no nesting.
//
// One issue is that swig is generating defineEnumeration calls for
// enums in the private part of classes. This usually isn't a
// problem, but the model in which some C code returns the
// underlying value won't compile because it is accessing a private
// type.
//
// It will be best to turn off binding to private parts of
// classes.
String *cppcode = NewString("");
// this is the namespace that will get used inside the functions
// returning enumerations.
String *namespaceprefix = getNamespacePrefix(tdname);
Wrapper *eW = NewWrapper();
Node *kk;
for (kk = firstChild(n); kk; kk = nextSibling(kk)) {
String *ename = Getattr(kk, "name");
String *fname = NewString("");
String *cfunctname = NewStringf("R_swigenum_%s_%s", mangled_tdname, ename);
String *rfunctname = NewStringf("R_swigenum_%s_%s_get", mangled_tdname, ename);
Printf(fname, "%s(void){", cfunctname);
Printf(cppcode, "SWIGEXPORT SEXP \n%s\n", fname);
Printf(cppcode, "int result;\n");
Printf(cppcode, "SEXP r_ans = R_NilValue;\n");
Printf(cppcode, "result = (int)%s%s;\n", namespaceprefix, ename);
Printf(cppcode, "r_ans = Rf_ScalarInteger(result);\n");
Printf(cppcode, "return(r_ans);\n}\n");
// Now emit the r binding functions
Printf(possiblescode, "`%s` = function(.copy=FALSE) {\n", rfunctname);
Printf(possiblescode, ".Call(\'%s\', as.logical(.copy), PACKAGE=\'%s\')\n}\n\n", cfunctname, Rpackage);
Printf(possiblescode, "attr(`%s`, \'returnType\')=\'integer\'\n", rfunctname);
Printf(possiblescode, "class(`%s`) = c(\"SWIGfunction\", class(\'%s\'))\n\n", rfunctname, rfunctname);
Delete(ename);
Delete(fname);
Delete(cfunctname);
Delete(rfunctname);
}
Printv(cppcode, "", NIL);
Printf(eW->code, "%s", cppcode);
Delete(cppcode);
Delete(namespaceprefix);
Printv(scode, "defineEnumeration('", mangled_tdname, "'", ",\n", tab8, tab8, tab4, ".values = c(\n", NIL);
Node *c; Node *c;
int value = -1; // First number is zero int value = -1; // First number is zero
bool needenumfunc = false; // Track whether we need runtime C
// calls to deduce correct enum values
for (c = firstChild(n); c; c = nextSibling(c)) { for (c = firstChild(n); c; c = nextSibling(c)) {
// const char *tag = Char(nodeType(c)); // const char *tag = Char(nodeType(c));
// if (Strcmp(tag,"cdecl") == 0) { // if (Strcmp(tag,"cdecl") == 0) {
name = Getattr(c, "name"); name = Getattr(c, "name");
// This needs to match the version earlier - could have stored it.
String *rfunctname = NewStringf("R_swigenum_%s_%s_get()", mangled_tdname, name);
String *val = Getattr(c, "enumvalue"); String *val = Getattr(c, "enumvalue");
if(val && Char(val)) { String *numstring = NewString("");
int inval = (int) getNumber(val);
if(inval == DEFAULT_NUMBER)
value++;
else
value = inval;
} else
value++;
Printf(scode, "%s%s%s'%s' = %d%s\n", tab8, tab8, tab8, name, value, if (val && Char(val)) {
nextSibling(c) ? ", " : ""); double inval = getNumber(val);
// } if (inval == DEFAULT_NUMBER) {
// This should indicate there is some fancy text there
// so we want to call the special R functions
needenumfunc = true;
Printf(numstring, "%s", rfunctname);
} else {
value = (int) inval;
Printf(numstring, "%d", value);
}
} else {
value++;
Printf(numstring, "%d", value);
}
Printf(scode, "%s%s%s'%s' = %s%s\n", tab8, tab8, tab8, name, numstring, nextSibling(c) ? ", " : "");
Delete(rfunctname);
Delete(numstring);
} }
Printv(scode, "))", NIL); Printv(scode, "))", NIL);
if (needenumfunc) {
Wrapper_print(eW, f_wrapper);
Printf(sfile, "%s\n", possiblescode);
}
Printf(sfile, "%s\n", scode); Printf(sfile, "%s\n", scode);
Delete(scode); Delete(scode);
Delete(possiblescode);
Delete(mangled_tdname); Delete(mangled_tdname);
return SWIG_OK; return SWIG_OK;
} }
@ -1250,16 +1304,14 @@ int R::variableWrapper(Node *n) {
if (!SwigType_isconst(ty)) { if (!SwigType_isconst(ty)) {
Wrapper *f = NewWrapper(); 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" : "");
name, addCopyParam ? ", .copy = FALSE" : ""); Printv(f->code, "if(missing(value)) {\n", name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL);
Printv(f->code, "if(missing(value)) {\n", Printv(f->code, " else {\n", name, "_set(value)\n}\n}", NIL);
name, "_get(", addCopyParam ? ".copy" : "", ")\n}", NIL);
Printv(f->code, " else {\n",
name, "_set(value)\n}\n}", NIL);
Wrapper_print(f, sfile); Wrapper_print(f, sfile);
DelWrapper(f); DelWrapper(f);
} else { } else {
Printf(sfile, "## constant in variableWrapper\n");
Printf(sfile, "%s = %s_get\n", name, name); Printf(sfile, "%s = %s_get\n", name, name);
} }
@ -1267,8 +1319,8 @@ int R::variableWrapper(Node *n) {
} }
void R::addAccessor(String *memberName, Wrapper *wrapper, String *name,
int isSet) { void R::addAccessor(String *memberName, Wrapper *wrapper, String *name, int isSet) {
if (isSet < 0) { if (isSet < 0) {
int n = Len(name); int n = Len(name);
char *ptr = Char(name); char *ptr = Char(name);
@ -1306,14 +1358,14 @@ struct Overloaded {
}; };
List * R::Swig_overload_rank(Node *n, List *R::Swig_overload_rank(Node *n, bool script_lang_wrapping) {
bool script_lang_wrapping) {
Overloaded nodes[MAX_OVERLOAD]; Overloaded nodes[MAX_OVERLOAD];
int nnodes = 0; int nnodes = 0;
Node *o = Getattr(n, "sym:overloaded"); Node *o = Getattr(n, "sym:overloaded");
if (!o) return 0; if (!o)
return 0;
Node *c = o; Node *c = o;
while (c) { while (c) {
@ -1396,10 +1448,12 @@ List * R::Swig_overload_rank(Node *n,
t1v = atoi(Char(t1)); t1v = atoi(Char(t1));
t2v = atoi(Char(t2)); t2v = atoi(Char(t2));
differ = t1v - t2v; differ = t1v - t2v;
} } else if (!t1 && t2)
else if (!t1 && t2) differ = 1; differ = 1;
else if (t1 && !t2) differ = -1; else if (t1 && !t2)
else if (!t1 && !t2) differ = -1; differ = -1;
else if (!t1 && !t2)
differ = -1;
num_checked++; num_checked++;
if (differ > 0) { if (differ > 0) {
Overloaded t = nodes[i]; Overloaded t = nodes[i];
@ -1484,8 +1538,7 @@ List * R::Swig_overload_rank(Node *n,
if (!Getattr(nodes[j].n, "overload:ignore")) if (!Getattr(nodes[j].n, "overload:ignore"))
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), 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)); "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), Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), "using %s instead.\n", Swig_name_decl(nodes[i].n));
"using %s instead.\n", Swig_name_decl(nodes[i].n));
} }
} }
nodes[j].error = 1; nodes[j].error = 1;
@ -1501,8 +1554,7 @@ List * R::Swig_overload_rank(Node *n,
if (!Getattr(nodes[j].n, "overload:ignore")) if (!Getattr(nodes[j].n, "overload:ignore"))
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), 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)); "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), Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), "using %s instead.\n", Swig_name_decl(nodes[i].n));
"using %s instead.\n", Swig_name_decl(nodes[i].n));
} }
} }
nodes[j].error = 1; nodes[j].error = 1;
@ -1517,14 +1569,12 @@ List * R::Swig_overload_rank(Node *n,
if (script_lang_wrapping) { if (script_lang_wrapping) {
Swig_warning(WARN_LANG_OVERLOAD_SHADOW, Getfile(nodes[j].n), Getline(nodes[j].n), 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)); "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), 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));
"as it is shadowed by %s.\n", Swig_name_decl(nodes[i].n));
} else { } else {
if (!Getattr(nodes[j].n, "overload:ignore")) if (!Getattr(nodes[j].n, "overload:ignore"))
Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[j].n), Getline(nodes[j].n), 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)); "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), Swig_warning(WARN_LANG_OVERLOAD_IGNORED, Getfile(nodes[i].n), Getline(nodes[i].n), "using %s instead.\n", Swig_name_decl(nodes[i].n));
"using %s instead.\n", Swig_name_decl(nodes[i].n));
} }
nodes[j].error = 1; nodes[j].error = 1;
} }
@ -1558,17 +1608,13 @@ void R::dispatchFunction(Node *n) {
if (constructor) if (constructor)
Replace(sfname, "new_", "", DOH_REPLACE_FIRST); Replace(sfname, "new_", "", DOH_REPLACE_FIRST);
Printf(f->def, Printf(f->def, "`%s` <- function(...) {", sfname);
"`%s` <- function(...) {", sfname);
if (debugMode) { if (debugMode) {
Swig_print_node(n); Swig_print_node(n);
} }
List *dispatch = Swig_overload_rank(n, true); List *dispatch = Swig_overload_rank(n, true);
int nfunc = Len(dispatch); int nfunc = Len(dispatch);
Printv(f->code, Printv(f->code, "argtypes <- mapply(class, list(...));\n", "argv <- list(...);\n", "argc <- length(argtypes);\n", NIL);
"argtypes <- mapply(class, list(...));\n",
"argv <- list(...);\n",
"argc <- length(argtypes);\n", NIL );
Printf(f->code, "# dispatch functions %d\n", nfunc); Printf(f->code, "# dispatch functions %d\n", nfunc);
int cur_args = -1; int cur_args = -1;
@ -1618,38 +1664,23 @@ void R::dispatchFunction(Node *n) {
if (debugMode) { if (debugMode) {
Printf(stdout, "<rtypecheck>%s\n", tmcheck); Printf(stdout, "<rtypecheck>%s\n", tmcheck);
} }
Printf(f->code, "%s(%s)", Printf(f->code, "%s(%s)", j == 0 ? "" : " && ", tmcheck);
j == 0? "" : " && ",
tmcheck);
p = Getattr(p, "tmap:in:next"); p = Getattr(p, "tmap:in:next");
continue; continue;
} }
if (tm) { if (tm) {
if (Strcmp(tm, "numeric") == 0) { if (Strcmp(tm, "numeric") == 0) {
Printf(f->code, "%sis.numeric(argv[[%d]])", Printf(f->code, "%sis.numeric(argv[[%d]])", j == 0 ? "" : " && ", j + 1);
j == 0 ? "" : " && ", } else if (Strcmp(tm, "integer") == 0) {
j+1); Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", j == 0 ? "" : " && ", j + 1, j + 1);
} } else if (Strcmp(tm, "character") == 0) {
else if (Strcmp(tm,"integer")==0) { Printf(f->code, "%sis.character(argv[[%d]])", j == 0 ? "" : " && ", j + 1);
Printf(f->code, "%s(is.integer(argv[[%d]]) || is.numeric(argv[[%d]]))", } else {
j == 0 ? "" : " && ", Printf(f->code, "%sextends(argtypes[%d], '%s')", j == 0 ? "" : " && ", j + 1, tm);
j+1, j+1);
}
else if (Strcmp(tm,"character")==0) {
Printf(f->code, "%sis.character(argv[[%d]])",
j == 0 ? "" : " && ",
j+1);
}
else {
Printf(f->code, "%sextends(argtypes[%d], '%s')",
j == 0 ? "" : " && ",
j+1,
tm);
} }
} }
if (!SwigType_ispointer(Getattr(p, "type"))) { if (!SwigType_ispointer(Getattr(p, "type"))) {
Printf(f->code, " && length(argv[[%d]]) == 1", Printf(f->code, " && length(argv[[%d]]) == 1", j + 1);
j+1);
} }
p = Getattr(p, "tmap:in:next"); p = Getattr(p, "tmap:in:next");
} }
@ -1659,10 +1690,7 @@ void R::dispatchFunction(Node *n) {
} }
} }
if (cur_args != -1) { if (cur_args != -1) {
Printf(f->code, "} else {\n" Printf(f->code, "} else {\n" "stop(\"cannot find overloaded function for %s with argtypes (\"," "toString(argtypes),\")\");\n" "}", sfname);
"stop(\"cannot find overloaded function for %s with argtypes (\","
"toString(argtypes),\")\");\n"
"}", sfname);
} }
Printv(f->code, ";\nf(...)", NIL); Printv(f->code, ";\nf(...)", NIL);
Printv(f->code, ";\n}", NIL); Printv(f->code, ";\n}", NIL);
@ -1680,8 +1708,7 @@ int R::functionWrapper(Node *n) {
String *type = Getattr(n, "type"); String *type = Getattr(n, "type");
if (debugMode) { if (debugMode) {
Printf(stdout, Printf(stdout, "<functionWrapper> %s %s %s\n", fname, iname, type);
"<functionWrapper> %s %s %s\n", fname, iname, type);
} }
String *overname = 0; String *overname = 0;
String *nodeType = Getattr(n, "nodeType"); String *nodeType = Getattr(n, "nodeType");
@ -1699,8 +1726,7 @@ int R::functionWrapper(Node *n) {
} }
if (debugMode) if (debugMode)
Printf(stdout, Printf(stdout, "<functionWrapper> processing parameters\n");
"<functionWrapper> processing parameters\n");
ParmList *l = Getattr(n, "parms"); ParmList *l = Getattr(n, "parms");
@ -1710,10 +1736,8 @@ int R::functionWrapper(Node *n) {
p = l; p = l;
while (p) { while (p) {
SwigType *resultType = Getattr(p, "type"); SwigType *resultType = Getattr(p, "type");
if (expandTypedef(resultType) && if (expandTypedef(resultType) && SwigType_istypedef(resultType)) {
SwigType_istypedef(resultType)) { SwigType *resolved = SwigType_typedef_resolve_all(resultType);
SwigType *resolved =
SwigType_typedef_resolve_all(resultType);
if (expandTypedef(resolved)) { if (expandTypedef(resolved)) {
Setattr(p, "type", Copy(resolved)); Setattr(p, "type", Copy(resolved));
} }
@ -1721,24 +1745,19 @@ int R::functionWrapper(Node *n) {
p = nextSibling(p); p = nextSibling(p);
} }
String *unresolved_return_type = String *unresolved_return_type = Copy(type);
Copy(type); if (expandTypedef(type) && SwigType_istypedef(type)) {
if (expandTypedef(type) && SwigType *resolved = SwigType_typedef_resolve_all(type);
SwigType_istypedef(type)) {
SwigType *resolved =
SwigType_typedef_resolve_all(type);
if (expandTypedef(resolved)) { if (expandTypedef(resolved)) {
type = Copy(resolved); type = Copy(resolved);
Setattr(n, "type", type); Setattr(n, "type", type);
} }
} }
if (debugMode) if (debugMode)
Printf(stdout, "<functionWrapper> unresolved_return_type %s\n", Printf(stdout, "<functionWrapper> unresolved_return_type %s\n", unresolved_return_type);
unresolved_return_type);
if (processing_member_access_function) { if (processing_member_access_function) {
if (debugMode) if (debugMode)
Printf(stdout, "<functionWrapper memberAccess> '%s' '%s' '%s' '%s'\n", Printf(stdout, "<functionWrapper memberAccess> '%s' '%s' '%s' '%s'\n", fname, iname, member_name, class_name);
fname, iname, member_name, class_name);
if (opaqueClassDeclaration) if (opaqueClassDeclaration)
return SWIG_OK; return SWIG_OK;
@ -1796,8 +1815,7 @@ int R::functionWrapper(Node *n) {
// if(addCopyParam) // if(addCopyParam)
if (debugMode) 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");
iname, type, addCopyParam ? "yes" : "no");
Printv(f->def, "SWIGEXPORT SEXP\n", wname, " ( ", NIL); Printv(f->def, "SWIGEXPORT SEXP\n", wname, " ( ", NIL);
@ -1892,8 +1910,7 @@ int R::functionWrapper(Node *n) {
String *snargs = NewStringf("%d", nargs); String *snargs = NewStringf("%d", nargs);
Printv(sfun->code, "if(is.function(", name, ")) {", "\n", Printv(sfun->code, "if(is.function(", name, ")) {", "\n",
"assert('...' %in% names(formals(", name, "assert('...' %in% names(formals(", name, ")) || length(formals(", name, ")) >= ", snargs, ");\n} ", NIL);
")) || length(formals(", name, ")) >= ", snargs, ");\n} ", NIL);
Delete(snargs); Delete(snargs);
Printv(sfun->code, "else {\n", Printv(sfun->code, "else {\n",
@ -1901,11 +1918,7 @@ int R::functionWrapper(Node *n) {
name, " = getNativeSymbolInfo(", name, ");", name, " = getNativeSymbolInfo(", name, ");",
"\n};\n", "\n};\n",
"if(is(", name, ", \"NativeSymbolInfo\")) {\n", "if(is(", name, ", \"NativeSymbolInfo\")) {\n",
name, " = ", name, "$address", ";\n}\n", name, " = ", name, "$address", ";\n}\n", "if(is(", name, ", \"ExternalReference\")) {\n", name, " = ", name, "@ref;\n}\n", "}; \n", NIL);
"if(is(", name, ", \"ExternalReference\")) {\n",
name, " = ", name, "@ref;\n}\n",
"}; \n",
NIL);
} else { } else {
Printf(sfun->code, "%s\n", tm); Printf(sfun->code, "%s\n", tm);
} }
@ -1948,8 +1961,7 @@ int R::functionWrapper(Node *n) {
Printf(f->code, "%s\n", tm); Printf(f->code, "%s\n", tm);
if (funcptr_name) if (funcptr_name)
Printf(f->code, "} else {\n%s = %s;\nR_SWIG_pushCallbackFunctionData(%s, NULL);\n}\n", Printf(f->code, "} else {\n%s = %s;\nR_SWIG_pushCallbackFunctionData(%s, NULL);\n}\n", lname, funcptr_name, name);
lname, funcptr_name, name);
Printv(f->def, inFirstArg ? "" : ", ", "SEXP ", name, NIL); Printv(f->def, inFirstArg ? "" : ", ", "SEXP ", name, NIL);
if (Len(name) != 0) if (Len(name) != 0)
inFirstArg = false; inFirstArg = false;
@ -2051,8 +2063,7 @@ int R::functionWrapper(Node *n) {
#endif #endif
} else { } else {
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, 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);
"Unable to use return type %s in function %s.\n", SwigType_str(type, 0), fname);
} }
@ -2063,9 +2074,7 @@ int R::functionWrapper(Node *n) {
if (!isVoidReturnType) if (!isVoidReturnType)
Printf(tmp, "Rf_protect(r_ans);\n"); Printf(tmp, "Rf_protect(r_ans);\n");
Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n", Printf(tmp, "Rf_protect(R_OutputValues = Rf_allocVector(VECSXP,%d));\nr_nprotect += %d;\n", numOutArgs + !isVoidReturnType, isVoidReturnType ? 1 : 2);
numOutArgs + !isVoidReturnType,
isVoidReturnType ? 1 : 2);
if (!isVoidReturnType) if (!isVoidReturnType)
Printf(tmp, "SET_VECTOR_ELT(R_OutputValues, 0, r_ans);\n"); Printf(tmp, "SET_VECTOR_ELT(R_OutputValues, 0, r_ans);\n");
@ -2104,13 +2113,10 @@ int R::functionWrapper(Node *n) {
} }
Printv(sfun->code, ";", (Len(tm) ? "ans = " : ""), ".Call('", wname, Printv(sfun->code, ";", (Len(tm) ? "ans = " : ""), ".Call('", wname, "', ", sargs, "PACKAGE='", Rpackage, "');\n", NIL);
"', ", sargs, "PACKAGE='", Rpackage, "');\n", NIL); if (Len(tm)) {
if(Len(tm))
{
Printf(sfun->code, "%s\n\n", tm); Printf(sfun->code, "%s\n\n", tm);
if (constructor) if (constructor) {
{
String *finalizer = NewString(iname); String *finalizer = NewString(iname);
Replace(finalizer, "new_", "", DOH_REPLACE_FIRST); Replace(finalizer, "new_", "", DOH_REPLACE_FIRST);
Printf(sfun->code, "reg.finalizer(ans@ref, delete_%s)\n", finalizer); Printf(sfun->code, "reg.finalizer(ans@ref, delete_%s)\n", finalizer);
@ -2137,15 +2143,11 @@ int R::functionWrapper(Node *n) {
replaceRClass(tm, retType); replaceRClass(tm, retType);
} }
Printv(sfile, "attr(`", sfname, "`, 'returnType') = '", Printv(sfile, "attr(`", sfname, "`, 'returnType') = '", isVoidReturnType ? "void" : (tm ? tm : ""), "'\n", NIL);
isVoidReturnType ? "void" : (tm ? tm : ""),
"'\n", NIL);
if (nargs > 0) if (nargs > 0)
Printv(sfile, "attr(`", sfname, "`, \"inputTypes\") = c(", Printv(sfile, "attr(`", sfname, "`, \"inputTypes\") = c(", s_inputTypes, ")\n", NIL);
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) { if (memoryProfile) {
Printv(sfile, "memory.profile()\n", NIL); Printv(sfile, "memory.profile()\n", NIL);
@ -2153,7 +2155,6 @@ int R::functionWrapper(Node *n) {
if (aggressiveGc) { if (aggressiveGc) {
Printv(sfile, "gc()\n", NIL); Printv(sfile, "gc()\n", NIL);
} }
// Printv(sfile, "setMethod('", name, "', '", name, "', ", iname, ")\n\n\n"); // Printv(sfile, "setMethod('", name, "', '", name, "', ", iname, ")\n\n\n");
@ -2167,8 +2168,7 @@ int R::functionWrapper(Node *n) {
addAccessor(member_name, sfun, iname); addAccessor(member_name, sfun, iname);
} }
if (Getattr(n, "sym:overloaded") && if (Getattr(n, "sym:overloaded") && !Getattr(n, "sym:nextSibling")) {
!Getattr(n, "sym:nextSibling")) {
dispatchFunction(n); dispatchFunction(n);
} }
@ -2205,8 +2205,7 @@ int R::addRegistrationRoutine(String *rname, int nargs) {
if (!registrationTable) if (!registrationTable)
registrationTable = NewHash(); registrationTable = NewHash();
String *el = String *el = NewStringf("{\"%s\", (DL_FUNC) &%s, %d}", rname, rname, nargs);
NewStringf("{\"%s\", (DL_FUNC) &%s, %d}", rname, rname, nargs);
Setattr(registrationTable, rname, el); Setattr(registrationTable, rname, el);
@ -2280,9 +2279,7 @@ void R::registerClass(Node *n) {
Printf(base, "c("); Printf(base, "c(");
for (int i = 0; i < Len(l); i++) { for (int i = 0; i < Len(l); i++) {
registerClass(Getitem(l, i)); registerClass(Getitem(l, i));
Printf(base, "'_p%s'%s", Printf(base, "'_p%s'%s", SwigType_manglestr(Getattr(Getitem(l, i), "name")), i < Len(l) - 1 ? ", " : "");
SwigType_manglestr(Getattr(Getitem(l, i), "name")),
i < Len(l)-1 ? ", " : "");
} }
Printf(base, ")"); Printf(base, ")");
} else { } else {
@ -2341,15 +2338,12 @@ int R::classDeclaration(Node *n) {
class_member_set_functions = NULL; class_member_set_functions = NULL;
} }
if (Getattr(n, "has_destructor")) { if (Getattr(n, "has_destructor")) {
Printf(sfile, "setMethod('delete', '_p%s', function(obj) {delete%s(obj)})\n", Printf(sfile, "setMethod('delete', '_p%s', function(obj) {delete%s(obj)})\n", getRClassName(Getattr(n, "name")), getRClassName(Getattr(n, "name")));
getRClassName(Getattr(n, "name")),
getRClassName(Getattr(n, "name")));
} }
if (!opaque && !Strcmp(kind, "struct") && copyStruct) { if (!opaque && !Strcmp(kind, "struct") && copyStruct) {
String *def = String *def = NewStringf("setClass(\"%s\",\n%srepresentation(\n", name, tab4);
NewStringf("setClass(\"%s\",\n%srepresentation(\n", name, tab4);
bool firstItem = true; bool firstItem = true;
for (Node *c = firstChild(n); c;) { for (Node *c = firstChild(n); c;) {
@ -2379,8 +2373,7 @@ int R::classDeclaration(Node *n) {
c = nextSibling(c); c = nextSibling(c);
continue; continue;
} }
if (Strcmp(tp, "character") && if (Strcmp(tp, "character") && Strstr(Getattr(c, "decl"), "p.")) {
Strstr(Getattr(c, "decl"), "p.")) {
c = nextSibling(c); c = nextSibling(c);
continue; continue;
} }
@ -2448,10 +2441,8 @@ int R::generateCopyRoutines(Node *n) {
if (debugMode) if (debugMode)
Printf(stdout, "generateCopyRoutines: name = %s, %s\n", name, type); 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);
mangledName, name); Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n", mangledName);
Printf(copyToC->def, "CopyToC%s = function(value, obj)\n{\n",
mangledName);
Node *c = firstChild(n); Node *c = firstChild(n);
@ -2472,8 +2463,7 @@ int R::generateCopyRoutines(Node *n) {
if (Strstr(tp, "R_class")) { if (Strstr(tp, "R_class")) {
continue; continue;
} }
if (Strcmp(tp, "character") && if (Strcmp(tp, "character") && Strstr(Getattr(c, "decl"), "p.")) {
Strstr(Getattr(c, "decl"), "p.")) {
continue; continue;
} }
@ -2494,17 +2484,16 @@ int R::generateCopyRoutines(Node *n) {
Printf(sfile, "# Start definition of copy methods for %s\n", rclassName); Printf(sfile, "# Start definition of copy methods for %s\n", rclassName);
Printf(sfile, "setMethod('copyToR', '_p_%s', CopyToR%s);\n", rclassName, Printf(sfile, "setMethod('copyToR', '_p_%s', CopyToR%s);\n", rclassName, mangledName);
mangledName); Printf(sfile, "setMethod('copyToC', '%s', CopyToC%s);\n\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 methods for %s\n", rclassName);
Printf(sfile, "# End definition of copy functions & methods for %s\n", rclassName); Printf(sfile, "# End definition of copy functions & methods for %s\n", rclassName);
String *m = NewStringf("%sCopyToR", name); String *m = NewStringf("%sCopyToR", name);
addNamespaceMethod(m); addNamespaceMethod(m);
char *tt = Char(m); tt[Len(m)-1] = 'C'; char *tt = Char(m);
tt[Len(m) - 1] = 'C';
addNamespaceMethod(m); addNamespaceMethod(m);
Delete(m); Delete(m);
Delete(rclassName); Delete(rclassName);
@ -2538,8 +2527,7 @@ int R::typedefHandler(Node *n) {
trueName += 7; trueName += 7;
if (debugMode) if (debugMode)
Printf(stdout, "<typedefHandler> Defining S class %s\n", trueName); Printf(stdout, "<typedefHandler> 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));
SwigType_manglestr(name));
} }
return Language::typedefHandler(n); return Language::typedefHandler(n);
@ -2559,8 +2547,7 @@ int R::membervariableHandler(Node *n) {
processing_member_access_function = 1; processing_member_access_function = 1;
member_name = Getattr(n, "sym:name"); member_name = Getattr(n, "sym:name");
if (debugMode) if (debugMode)
Printf(stdout, "<membervariableHandler> name = %s, sym:name = %s\n", Printf(stdout, "<membervariableHandler> name = %s, sym:name = %s\n", Getattr(n, "name"), member_name);
Getattr(n, "name"), member_name);
int status(Language::membervariableHandler(n)); int status(Language::membervariableHandler(n));
@ -2683,8 +2670,7 @@ void R::main(int argc, char *argv[]) {
Could make this work for String or File and then just store the resulting string Could make this work for String or File and then just store the resulting string
rather than the collection of arguments and argc. rather than the collection of arguments and argc.
*/ */
int R::outputCommandLineArguments(File *out) int R::outputCommandLineArguments(File *out) {
{
if (Argc < 1 || !Argv || !Argv[0]) if (Argc < 1 || !Argv || !Argv[0])
return (-1); return (-1);
@ -2701,8 +2687,7 @@ int R::outputCommandLineArguments(File *out)
/* How SWIG instantiates an object from this module. /* How SWIG instantiates an object from this module.
See swigmain.cxx */ See swigmain.cxx */
extern "C" extern "C" Language *swig_r(void) {
Language *swig_r(void) {
return new R(); return new R();
} }
@ -2722,10 +2707,8 @@ String * R::processType(SwigType *t, Node *n, int *nargs) {
Printf(stdout, "processType %s (tdname = %s)\n", Getattr(n, "name"), tmp); Printf(stdout, "processType %s (tdname = %s)\n", Getattr(n, "name"), tmp);
SwigType *td = t; SwigType *td = t;
if (expandTypedef(t) && if (expandTypedef(t) && SwigType_istypedef(t)) {
SwigType_istypedef(t)) { SwigType *resolved = SwigType_typedef_resolve_all(t);
SwigType *resolved =
SwigType_typedef_resolve_all(t);
if (expandTypedef(resolved)) { if (expandTypedef(resolved)) {
td = Copy(resolved); td = Copy(resolved);
} }
@ -2750,17 +2733,14 @@ String * R::processType(SwigType *t, Node *n, int *nargs) {
if (SwigType_isfunctionpointer(t)) { if (SwigType_isfunctionpointer(t)) {
if (debugMode) if (debugMode)
Printf(stdout, Printf(stdout, "<processType> Defining pointer handler %s\n", t);
"<processType> Defining pointer handler %s\n", t);
String *tmp = createFunctionPointerHandler(t, n, nargs); String *tmp = createFunctionPointerHandler(t, n, nargs);
return tmp; return tmp;
} }
#if 0 #if 0
SwigType_isfunction(t) && SwigType_ispointer(t) SwigType_isfunction(t) && SwigType_ispointer(t)
#endif #endif
return NULL; return NULL;
} }
@ -2773,8 +2753,3 @@ String * R::processType(SwigType *t, Node *n, int *nargs) {
/*************************************************************************************/ /*************************************************************************************/