PageRenderTime 48ms CodeModel.GetById 45ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/Lib/r/r.swg

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