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

first pass at making fcompact work with R

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@11722 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Joseph Wang 2009-11-04 03:48:17 +00:00
commit e351dfceaf
2 changed files with 25 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

16
Lib/r/rtype.swg
View file

@ -100,30 +100,30 @@
long *, long *,
long &, long &,
long[ANY] long[ANY]
"$input = as.integer($input) "; "$input = as.integer($input); ";
%typemap(scoercein) char *, string, std::string, %typemap(scoercein) char *, string, std::string,
string &, std::string & string &, std::string &
%{ $input = as($input, "character") %} %{ $input = as($input, "character"); %}
%typemap(scoerceout) enum SWIGTYPE %typemap(scoerceout) enum SWIGTYPE
%{ $result = enumFromInteger($result, "$R_class") %} %{ $result = enumFromInteger($result, "$R_class"); %}
%typemap(scoerceout) enum SWIGTYPE & %typemap(scoerceout) enum SWIGTYPE &
%{ $result = enumFromInteger($result, "$R_class") %} %{ $result = enumFromInteger($result, "$R_class"); %}
%typemap(scoerceout) enum SWIGTYPE * %typemap(scoerceout) enum SWIGTYPE *
%{ $result = enumToInteger($result, "$R_class") %} %{ $result = enumToInteger($result, "$R_class"); %}
%typemap(scoerceout) SWIGTYPE %typemap(scoerceout) SWIGTYPE
%{ class($result) <- "$&R_class" %} %{ class($result) <- "$&R_class"; %}
%typemap(scoerceout) SWIGTYPE & %typemap(scoerceout) SWIGTYPE &
%{ class($result) <- "$R_class" %} %{ class($result) <- "$R_class"; %}
%typemap(scoerceout) SWIGTYPE * %typemap(scoerceout) SWIGTYPE *
%{ class($result) <- "$R_class" %} %{ class($result) <- "$R_class"; %}
/* Override the SWIGTYPE * above. */ /* Override the SWIGTYPE * above. */
%typemap(scoerceout) char, %typemap(scoerceout) char,

34
Source/Modules/r.cxx
View file

@ -1101,7 +1101,7 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
Delete(pitem); Delete(pitem);
} }
Delete(itemList); Delete(itemList);
Printf(f->code, ")\n"); Printf(f->code, ");\n");
if (!isSet && varaccessor > 0) { if (!isSet && varaccessor > 0) {
Printf(f->code, "%svaccessors = c(", tab8); Printf(f->code, "%svaccessors = c(", tab8);
@ -1117,7 +1117,7 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
Printf(f->code, "'%s'%s", item, vcount < varaccessor ? ", " : ""); Printf(f->code, "'%s'%s", item, vcount < varaccessor ? ", " : "");
} }
} }
Printf(f->code, ")\n"); Printf(f->code, ");\n");
} }
@ -1129,24 +1129,24 @@ 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", "idx = pmatch(name, names(accessorFuns));\n",
tab8, tab8,
"if(is.na(idx)) \n", "if(is.na(idx)) \n",
tab8, tab4, NIL); tab8, tab4, NIL);
Printf(f->code, "return(callNextMethod(x, name%s))\n", Printf(f->code, "return(callNextMethod(x, name%s));\n",
isSet ? ", value" : ""); 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 {
Printv(f->code, tab8, "formals(f)[[1]] = x\n", NIL); Printv(f->code, tab8, "formals(f)[[1]] = x;\n", NIL);
if (varaccessor) { if (varaccessor) {
Printv(f->code, tab8, Printv(f->code, tab8,
"if (is.na(match(name, vaccessors))) f else f(x)\n", NIL); "if (is.na(match(name, vaccessors))) f else f(x);\n", NIL);
} else { } else {
Printv(f->code, tab8, "f\n", NIL); Printv(f->code, tab8, "f;\n", NIL);
} }
} }
Printf(f->code, "}\n"); Printf(f->code, "}\n");
@ -1157,15 +1157,15 @@ int R::OutputMemberReferenceMethod(String *className, int isSet,
isSet ? "<-" : "", isSet ? "<-" : "",
getRClassName(className)); 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);
Printf(out, ")\n"); Printf(out, ");\n");
} }
DelWrapper(attr); DelWrapper(attr);
@ -2090,10 +2090,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\nans\n", tm); Printf(sfun->code, "%s\n\nans;\n", tm);
if (destructor) if (destructor)
Printv(f->code, "R_ClearExternalPtr(self);\n", NIL); Printv(f->code, "R_ClearExternalPtr(self);\n", NIL);