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 %{ 12 SWIGEXPORT 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) 30 return R_NilValue; 31 %enddef 32 33 %insert("sinit") "srun.swg" 34 35 %insert("sinitroutine") %{ 36 SWIG_init(); 37 SWIG_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 %typemap(freearg, noblock=1) int *OUTPUT, 113 signed int *OUTPUT, 114 unsigned int *OUTPUT, 115 short *OUTPUT, 116 signed short *OUTPUT, 117 unsigned short *OUTPUT, 118 long *OUTPUT, 119 signed long *OUTPUT, 120 unsigned long *OUTPUT, 121 long long *OUTPUT, 122 signed long long *OUTPUT, 123 unsigned long long *OUTPUT, 124 float *OUTPUT, 125 double *OUTPUT, 126 char *OUTPUT, 127 signed char *OUTPUT, 128 unsigned char *OUTPUT 129 {} 130 131 132 133 /* Should we recycle to make the length correct. 134 And warn if length() > the dimension. 135 */ 136 %typemap(scheck) SWIGTYPE [ANY] %{ 137 # assert(length($input) >= $1_dim0) 138 %} 139 140 /* Handling vector case to avoid warnings, 141 although we just use the first one. */ 142 %typemap(scheck) unsigned int %{ 143 assert(length($input) == 1 && $input >= 0, "All values must be non-negative"); 144 %} 145 146 147 %typemap(scheck) int, long %{ 148 if(length($input) > 1) { 149 warning("using only the first element of $input"); 150 }; 151 %} 152 153 %include <typemaps/fragments.swg> 154 %include <rfragments.swg> 155 %include <ropers.swg> 156 %include <typemaps/swigtypemaps.swg> 157 %include <rtype.swg> 158 159 %typemap(in,noblock=1) enum SWIGTYPE[ANY] { 160 $1 = %reinterpret_cast(INTEGER($input), $1_ltype); 161 } 162 163 %typemap(in,noblock=1,fragment="SWIG_strdup") char * { 164 $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype); 165 } 166 167 %typemap(freearg,noblock=1) char * { 168 free($1); 169 } 170 171 %typemap(in,noblock=1,fragment="SWIG_strdup") char *[ANY] { 172 $1 = %reinterpret_cast(SWIG_strdup(CHAR(STRING_ELT($input, 0))), $1_ltype); 173 } 174 175 %typemap(freearg,noblock=1) char *[ANY] { 176 free($1); 177 } 178 179 %typemap(in,noblock=1,fragment="SWIG_strdup") char[ANY] { 180 $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0))); 181 } 182 183 %typemap(freearg,noblock=1) char[ANY] { 184 free($1); 185 } 186 187 %typemap(in,noblock=1,fragment="SWIG_strdup") char[] { 188 $1 = SWIG_strdup(CHAR(STRING_ELT($input, 0))); 189 } 190 191 %typemap(freearg,noblock=1) char[] { 192 free($1); 193 } 194 195 196 %typemap(memberin) char[] %{ 197 if ($input) strcpy($1, $input); 198 else 199 strcpy($1, ""); 200 %} 201 202 %typemap(globalin) char[] %{ 203 if ($input) strcpy($1, $input); 204 else 205 strcpy($1, ""); 206 %} 207 208 %typemap(out,noblock=1) char * 209 { $result = $1 ? Rf_mkString(%reinterpret_cast($1,char *)) : R_NilValue; } 210 211 %typemap(in,noblock=1) char { 212 $1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype); 213 } 214 215 %typemap(out) char 216 { 217 char tmp[2] = "x"; 218 tmp[0] = $1; 219 $result = Rf_mkString(tmp); 220 } 221 222 223 %typemap(in,noblock=1) int, long 224 { 225 $1 = %static_cast(INTEGER($input)[0], $1_ltype); 226 } 227 228 %typemap(out,noblock=1) int, long 229 "$result = Rf_ScalarInteger($1);"; 230 231 232 %typemap(in,noblock=1) bool 233 "$1 = LOGICAL($input)[0] ? true : false;"; 234 235 236 %typemap(out,noblock=1) bool 237 "$result = Rf_ScalarLogical($1);"; 238 239 %typemap(in,noblock=1) 240 float, 241 double 242 { 243 $1 = %static_cast(REAL($input)[0], $1_ltype); 244 } 245 246 /* Why is this here ? */ 247 /* %typemap(out,noblock=1) unsigned int * 248 "$result = ScalarReal(*($1));"; */ 249 250 %Rruntime %{ 251 setMethod('[', "ExternalReference", 252 function(x,i,j, ..., drop=TRUE) 253 if (!is.null(x$"__getitem__")) 254 sapply(i, function(n) x$"__getitem__"(i=as.integer(n-1)))) 255 256 setMethod('[<-' , "ExternalReference", 257 function(x,i,j, ..., value) 258 if (!is.null(x$"__setitem__")) { 259 sapply(1:length(i), function(n) 260 x$"__setitem__"(i=as.integer(i[n]-1), x=value[n])) 261 x 262 }) 263 264 setAs('ExternalReference', 'character', 265 function(from) {if (!is.null(from$"__str__")) from$"__str__"()}) 266 267 setMethod('print', 'ExternalReference', 268 function(x) {print(as(x, "character"))}) 269 %} 270 271 272 273
