← Back to branch summary

~ubuntu-branches/ubuntu/maverick/swig1.3/maverick

« back to all changes in this revision

Viewing changes to Lib/r/r.swg

  • Committer: Bazaar Package Importer
  • Author(s): Michael Vogt
  • Date: 2006-12-20 14:43:24 UTC
  • mfrom: (1.2.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20061220144324-bps3kb06xp5oy9w1
Tags: 1.3.31-1ubuntu1
* Merge from debian unstable, remaining changes:
  - drop support for pike
  - use php5 instead of php4
  - clean Runtime/ as well
  - force a few environment variables

Show diffs side-by-side

added added

removed removed

Lines of Context:
Lib/r/r.swg
 
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
#define %Rruntime %insert("s")
 
16
 
 
17
#define SWIG_Object SEXP
 
18
#define VOID_Object R_NilValue
 
19
 
 
20
#define %append_output(obj) SET_VECTOR_ELT($result, $n, obj)
 
21
 
 
22
%define %set_constant(name, obj) %begin_block
 
23
   SEXP _obj = obj;
 
24
   assign(name, _obj);
 
25
%end_block %enddef
 
26
 
 
27
%define %raise(obj,type,desc) 
 
28
return R_NilValue;
 
29
%enddef
 
30
 
 
31
%insert("sinit") "srun.swg"
 
32
 
 
33
%insert("sinitroutine") %{
 
34
SWIG_init();
 
35
SWIG_InitializeModule(0);
 
36
%}
 
37
 
 
38
%include <typemaps/swigmacros.swg>
 
39
%typemap(in) (double *x, int len) %{
 
40
   $1 = REAL(x);
 
41
   $2 = Rf_length(x);
 
42
%}
 
43
 
 
44
/* XXX
 
45
   Need to worry about inheritance, e.g. if B extends A 
 
46
   and we are looking for an A[], then B elements are okay.
 
47
*/
 
48
%typemap(scheck) SWIGTYPE[ANY]  
 
49
  %{ 
 
50
#      assert(length($input) > $1_dim0)
 
51
      assert(all(sapply($input, class) == "$R_class"))     
 
52
  %}
 
53
 
 
54
%typemap(out) void "";
 
55
 
 
56
%typemap(in) int *, int[ANY] %{
 
57
  $1 = INTEGER($input);
 
58
%}
 
59
 
 
60
%typemap(in) double *, double[ANY] %{
 
61
  $1 = REAL($input);
 
62
%}
 
63
 
 
64
/* Shoul dwe recycle to make the length correct.
 
65
   And warn if length() > the dimension. 
 
66
*/
 
67
%typemap(scheck) SWIGTYPE [ANY] %{
 
68
#  assert(length($input) >= $1_dim0)
 
69
%}
 
70
 
 
71
/* Handling vector case to avoid warnings,
 
72
   although we just use the first one. */
 
73
%typemap(scheck) unsigned int %{
 
74
  assert(length($input) == 1 && $input >= 0, "All values must be non-negative")
 
75
%}
 
76
 
 
77
 
 
78
%typemap(scheck) int %{
 
79
  if(length($input) > 1) {
 
80
     warning("using only the first element of $input")
 
81
  }
 
82
%}
 
83
 
 
84
 
 
85
%include <typemaps/swigmacros.swg>
 
86
%include <typemaps/fragments.swg>
 
87
%include <rfragments.swg>
 
88
%include <ropers.swg>
 
89
%include <typemaps/swigtypemaps.swg>
 
90
%include <rtype.swg>
 
91
 
 
92
%apply int[ANY] { enum SWIGTYPE[ANY] };
 
93
 
 
94
%typemap(in,noblock=1) enum SWIGTYPE[ANY] {
 
95
   $1 = %reinterpret_cast(INTEGER($input), $1_ltype);
 
96
}
 
97
 
 
98
%typemap(in,noblock=1) char* {
 
99
   $1 = %reinterpret_cast(CHAR(STRING_ELT($input, 0)), $1_ltype);
 
100
}
 
101
 
 
102
%typemap(in,noblock=1) char *[ANY]  {
 
103
   $1 = %reinterpret_cast(CHAR(STRING_ELT($input, 0)), $1_ltype);
 
104
}
 
105
 
 
106
%typemap(in,noblock=1) char[ANY]
 
107
  "$1 = CHAR(STRING_ELT($input, 0));";
 
108
 
 
109
%typemap(in,noblock=1) char[]
 
110
  "$1 = CHAR(STRING_ELT($input, 0));";
 
111
 
 
112
%typemap(memberin) char[] %{
 
113
if ($input) strcpy($1, $input);
 
114
else
 
115
strcpy($1, "");
 
116
%}
 
117
 
 
118
%typemap(globalin) char[] %{
 
119
if ($input) strcpy($1, $input);
 
120
else
 
121
strcpy($1, "");
 
122
%}
 
123
 
 
124
%typemap(out,noblock=1) char* 
 
125
 {  $result = $1 ? mkString(%reinterpret_cast($1,char *)) : R_NilValue; }
 
126
 
 
127
%typemap(in,noblock=1) char {
 
128
$1 = %static_cast(CHAR(STRING_ELT($input, 0))[0],$1_ltype);
 
129
}
 
130
 
 
131
%typemap(out,noblock=1) char 
 
132
 { 
 
133
    char tmp[2] = "x";
 
134
    tmp[0] = $1;    
 
135
    $result = mkString(tmp); 
 
136
 }
 
137
 
 
138
 
 
139
%typemap(in,noblock=1) int {
 
140
  $1 = %static_cast(INTEGER($input)[0], $1_ltype);
 
141
}
 
142
 
 
143
%typemap(out,noblock=1) int 
 
144
  "$result = ScalarInteger($1);";
 
145
 
 
146
 
 
147
%typemap(in,noblock=1) bool 
 
148
  "$1 = LOGICAL($input)[0];";
 
149
 
 
150
 
 
151
%typemap(out,noblock=1) bool 
 
152
  "$result = ScalarLogical($1);";
 
153
 
 
154
%typemap(in,noblock=1) unsigned int, 
 
155
             unsigned long,
 
156
             float, 
 
157
             double,
 
158
             long 
 
159
{
 
160
  $1 = %static_cast(REAL($input)[0], $1_ltype); 
 
161
}
 
162
 
 
163
 
 
164
%typemap(out,noblock=1) unsigned int *
 
165
  "$result = ScalarReal(*($1));";
 
166
 
 
167
%Rruntime %{
 
168
setMethod('[', "ExternalReference",
 
169
function(x,i,j, ..., drop=TRUE) 
 
170
if (!is.null(x$"__getitem__")) 
 
171
sapply(i, function(n) x$"__getitem__"(i=as.integer(n-1))))
 
172
 
 
173
setMethod('[<-' , "ExternalReference",
 
174
function(x,i,j, ..., value) 
 
175
if (!is.null(x$"__setitem__")) {
 
176
sapply(1:length(i), function(n) 
 
177
x$"__setitem__"(i=as.integer(i[n]-1), x=value[n]))
 
178
x
 
179
})
 
180
 
 
181
setAs('ExternalReference', 'character',
 
182
function(from) {if (!is.null(from$"__str__")) from$"__str__"()})
 
183
 
 
184
setMethod('print', 'ExternalReference',
 
185
function(x) {print(as(x, "character"))})
 
186
%}
 
187
 
 
188
 
 
189