1/* */ 2 3 4%insert("header") "swiglabels.swg" 5 6%insert("header") "swigerrors.swg" 7%insert("init") "swiginit.swg" 8%insert("runtime") "swigrun.swg" 9%insert("runtime") "rrun.swg" 10 11%init %{ 12SWIGEXPORT void SWIG_init(void) { 13%} 14 15%include <rkw.swg> 16 17#define %Rruntime %insert("s") 18 19#define SWIG_Object SEXP 20#define VOID_Object R_NilValue 21 22#define %append_output(obj) SET_VECTOR_ELT($result, $n, obj) 23 24%define %set_constant(name, obj) %begin_block 25 SEXP _obj = obj; 26 assign(name, _obj); 27%end_block %enddef 28 29%define %raise(obj,type,desc) 30return R_NilValue; 31%enddef 32 33%insert("sinit") "srun.swg" 34 35%insert("sinitroutine") %{ 36SWIG_init(); 37SWIG_InitializeModule(0); 38%} 39 40%include <typemaps/swigmacros.swg> 41%typemap(in) (double *x, int len) %{ 42 $1 = REAL(x); 43 $2 = Rf_length(x); 44%} 45 46/* XXX 47 Need to worry about inheritance, e.g. if B extends A 48 and we are looking for an A[], then B elements are okay. 49*/ 50%typemap(scheck) SWIGTYPE[ANY] 51 %{ 52# assert(length($input) > $1_dim0) 53 assert(all(sapply($input, class) == "$R_class")) 54 %} 55 56%typemap(out) void ""; 57 58%typemap(in) int *, int[ANY], 59 signed int *, signed int[ANY], 60 unsigned int *, unsigned int[ANY], 61 short *, short[ANY], 62 signed short *, signed short[ANY], 63 unsigned short *, unsigned short[ANY], 64 long *, long[ANY], 65 signed long *, signed long[ANY], 66 unsigned long *, unsigned long[ANY], 67 long long *, long long[ANY], 68 signed long long *, signed long long[ANY], 69 unsigned long long *, unsigned long long[ANY] 70 71{ 72{ int _rswigi; 73 int _rswiglen = LENGTH($input); 74 $1 = %static_cast(calloc(sizeof($1_basetype), _rswiglen), $1_ltype); 75 for (_rswigi=0; _rswigi< _rswiglen; _rswigi++) { 76 $1[_rswigi] = INTEGER($input)[_rswigi]; 77 } 78} 79} 80 81%typemap(in) float *, float[ANY], 82 double *, double[ANY] 83 84{ 85{ int _rswigi; 86 int _rswiglen = LENGTH($input); 87 $1 = %static_cast(calloc(sizeof($1_basetype), _rswiglen), $1_ltype); 88 for (_rswigi=0; _rswigi<_rswiglen; _rswigi++) { 89 $1[_rswigi] = REAL($input)[_rswigi]; 90 } 91} 92} 93 94%typemap(freearg,noblock=1) int *, int[ANY], 95 signed int *, signed int[ANY], 96 unsigned int *, unsigned int[ANY], 97 short *, short[ANY], 98 signed short *, signed short[ANY], 99 unsigned short *, unsigned short[ANY], 100 long *, long[ANY], 101 signed long *, signed long[ANY], 102 unsigned long *, unsigned long[ANY], 103 long long *, long long[ANY], 104 signed long long *, signed long long[ANY], 105 unsigned long long *, unsigned long long[ANY], 106 float *, float[ANY], 107 double *, double[ANY] 108%{ 109 free($1); 110%} 111 112 113 114 115/* Shoul dwe recycle to make the length correct. 116 And warn if length() > the dimension. 117*/ 118%typemap(scheck) SWIGTYPE [ANY] %{ 119# assert(length($input) >= $1_dim0) 120%} 121 122/* Handling vector case to avoid warnings, 123 although we just use the first one. */ 124%typemap(scheck) unsigned int %{ 125 assert(length($input) == 1 && $input >= 0, "All values must be non-negative") 126%} 127 128 129%typemap(scheck) int, long %{ 130 if(length($input) > 1) { 131 warning("using only the first element of $input") 132 } 133%} 134 135 136%include <typemaps/swigmacros.swg> 137%include <typemaps/fragments.swg> 138%include <rfragments.swg> 139%include <ropers.swg> 140%include <typemaps/swigtypemaps.swg> 141%include <rtype.swg> 142 143%typemap(in,noblock=1) enum SWIGTYPE[ANY] { 144 $1 = %reinterpret_cast(INTEGER($input), $1_ltype); 145} 146 147%typemap(in,noblock=1,fragment="SWIG_strdup") char* { 148 $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype); 149} 150 151%typemap(freearg,noblock=1) char* { 152 free($1); 153} 154 155%typemap(in,noblock=1,fragment="SWIG_strdup") char *[ANY] { 156 $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype); 157} 158 159%typemap(freearg,noblock=1) char *[ANY] { 160 free($1); 161} 162 163%typemap(in,noblock=1,fragment="SWIG_strdup") char[ANY] { 164 $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0))); 165} 166 167%typemap(freearg,noblock=1) char[ANY] { 168 free($1); 169} 170 171%typemap(in,noblock=1,fragment="SWIG_strdup") char[] { 172 $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0))); 173} 174 175%typemap(freearg,noblock=1) char[] { 176 free($1); 177} 178 179 180%typemap(memberin) char[] %{ 181if ($input) strcpy($1, $input); 182else 183strcpy($1, ""); 184%} 185 186%typemap(globalin) char[] %{ 187if ($input) strcpy($1, $input); 188else 189strcpy($1, ""); 190%} 191 192%typemap(out,noblock=1) char* 193 { $result = $1 ? Rf_mkString(%reinterpret_cast($1,char *)) : R_NilValue; } 194 195%typemap(in,noblock=1) char { 196$1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); 197} 198 199%typemap(out) char 200 { 201 char tmp[2] = "x"; 202 tmp[0] = $1; 203 $result = Rf_mkString(tmp); 204 } 205 206 207%typemap(in,noblock=1) int, long 208{ 209 $1 = %static_cast(INTEGER($input)[0], $1_ltype); 210} 211 212%typemap(out,noblock=1) int, long 213 "$result = Rf_ScalarInteger($1);"; 214 215 216%typemap(in,noblock=1) bool 217 "$1 = LOGICAL($input)[0] ? true : false;"; 218 219 220%typemap(out,noblock=1) bool 221 "$result = Rf_ScalarLogical($1);"; 222 223%typemap(in,noblock=1) 224 float, 225 double 226{ 227 $1 = %static_cast(REAL($input)[0], $1_ltype); 228} 229 230/* Why is this here ? */ 231/* %typemap(out,noblock=1) unsigned int * 232 "$result = ScalarReal(*($1));"; */ 233 234%Rruntime %{ 235setMethod('[', "ExternalReference", 236function(x,i,j, ..., drop=TRUE) 237if (!is.null(x$"__getitem__")) 238sapply(i, function(n) x$"__getitem__"(i=as.integer(n-1)))) 239 240setMethod('[<-' , "ExternalReference", 241function(x,i,j, ..., value) 242if (!is.null(x$"__setitem__")) { 243sapply(1:length(i), function(n) 244x$"__setitem__"(i=as.integer(i[n]-1), x=value[n])) 245x 246}) 247 248setAs('ExternalReference', 'character', 249function(from) {if (!is.null(from$"__str__")) from$"__str__"()}) 250 251setMethod('print', 'ExternalReference', 252function(x) {print(as(x, "character"))}) 253%} 254 255 256 257