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