« back to all changes in this revision
Viewing changes to src/rpymodule2040.c
- browse files at revision 5
- compare with another revision
- download diff
- download tarball
- view history from revision 5
- Committer: Bazaar Package Importer
- Author(s): Dirk Eddelbuettel
- Date: 2008-06-17 14:15:55 UTC
- mfrom: (2.1.18 intrepid)
- Revision ID: james.westby@ubuntu.com-20080617141555-zcqin5xjerohcw5r
Tags: 1.0.3-2
* Rebuilt under R 2.7.1.rc
* debian/control: Upgraded Build-Depends: to new R version
* Applied upstream fixes to setup.py and rpy_tools.py committed by Greg
that correctly deal with the Rlapack vs lapack linking change.
* debian/control: Upgraded Build-Depends: to new R version
* Applied upstream fixes to setup.py and rpy_tools.py committed by Greg
that correctly deal with the Rlapack vs lapack linking change.
- files added:
- ChangeLog
- files removed:
- src/R_eval2031.c
- files modified:
- INSTALL.WINDOWS
added
removed
src/rpymodule2040.c
1
/*
2
* $Id: rpymodule.c 299 2006-03-22 22:13:54Z warnes $
3
* Implementation of the module '_rpy' and the 'Robj' type.
4
*/
5
6
/* ***** BEGIN LICENSE BLOCK *****
7
* Version: MPL 1.1/GPL 2.0/LGPL 2.1
8
*
9
* The contents of this file are subject to the Mozilla Public License Version
10
* 1.1 (the "License"); you may not use this file except in compliance with
11
* the License. You may obtain a copy of the License at
12
* http://www.mozilla.org/MPL/
13
*
14
* Software distributed under the License is distributed on an "AS IS" basis,
15
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
16
* for the specific language governing rights and limitations under the
17
* License.
18
*
19
* The Original Code is the RPy python module.
20
*
21
* The Initial Developer of the Original Code is Walter Moreira.
22
* Portions created by the Initial Developer are Copyright (C) 2002
23
* the Initial Developer. All Rights Reserved.
24
*
25
* Contributor(s):
26
* Gregory R. Warnes <greg@warnes.net> (Maintainer)
27
*
28
* Alternatively, the contents of this file may be used under the terms of
29
* either the GNU General Public License Version 2 or later (the "GPL"), or
30
* the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
31
* in which case the provisions of the GPL or the LGPL are applicable instead
32
* of those above. If you wish to allow use of your version of this file only
33
* under the terms of either the GPL or the LGPL, and not to allow others to
34
* use your version of this file under the terms of the MPL, indicate your
35
* decision by deleting the provisions above and replace them with the notice
36
* and other provisions required by the GPL or the LGPL. If you do not delete
37
* the provisions above, a recipient may use your version of this file under
38
* the terms of any one of the MPL, the GPL or the LGPL.
39
*
40
* ***** END LICENSE BLOCK ***** */
41
42
#include "RPy.h"
43
44
#define NONAMELESSUNION
45
#include <stdio.h>
46
#include <stdlib.h>
47
#include <string.h>
48
49
/* Flag indicating whether Numeric is available in this session
50
*
51
* This is necessary Numeric may not available at run time, even if
52
* it was available at compile time.
53
*/
54
static int use_numeric=0;
55
56
57
/* Local function definitions */
58
DL_EXPORT(void) INIT_RPY(void); /* Module initializer */
59
static PyObject *r_init(PyObject *self, /* Class initializer */
60
PyObject *args);
61
static PyObject *r_cleanup(void); /* Clean up R & release resources */
62
63
#ifdef _WIN32
64
static void init_embedded_win32( void );
65
#endif
66
67
/* Global objects */
68
static SEXP get_item;
69
static SEXP set_item;
70
static SEXP length;
71
static SEXP aperm;
72
static PyObject *class_table;
73
static PyObject *proc_table;
74
static int default_mode;
75
static PyObject *r_lock;
76
PyObject *RPyExc_Exception;
77
78
static char RHOME[BUFSIZ];
79
static char RVERSION[BUFSIZ];
80
static char RVER[BUFSIZ];
81
static char RUSER[BUFSIZ];
82
83
/* Global interpreter */
84
PyInterpreterState *my_interp;
85
86
/* Signal whether R is running interactively */
87
int R_interact;
88
89
/* RPy namespace */
90
PyObject *rpy;
91
PyObject *rpy_dict;
92
93
94
#ifdef WITH_NUMERIC
95
static PyObject *Py_transpose;
96
#endif
97
98
/* Global list to protect R objects from garbage collection */
99
/* This is inspired in $R_SRC/src/main/memory.c */
100
static SEXP R_References;
101
102
static SEXP
103
RecursiveRelease(SEXP obj, SEXP list)
104
{
105
if (!isNull(list)) {
106
if (obj == CAR(list))
107
return CDR(list);
108
else
109
SETCDR(list, RecursiveRelease(obj, CDR(list)));
110
}
111
return list;
112
}
113
114
/* Robj methods. Following xxmodule.c from Python distro. */
115
116
static void
117
Robj_dealloc(RobjObject *self)
118
{
119
/* Remove the object from the list of protected objects */
120
R_References = RecursiveRelease(self->R_obj, R_References);
121
SET_SYMVALUE(install("R.References"), R_References);
122
123
PyObject_Del(self);
124
}
125
126
RobjObject *
127
Robj_new(SEXP robj, int conversion)
128
{
129
RobjObject *self;
130
self = PyObject_New(RobjObject, &Robj_Type);
131
if (!self)
132
return NULL;
133
134
if (!robj)
135
return NULL;
136
137
/* Protect the R object */
138
R_References = CONS(robj, R_References);
139
SET_SYMVALUE(install("R.References"), R_References);
140
141
self->R_obj = robj;
142
self->conversion = conversion;
143
return self;
144
}
145
146
#ifndef PRE_2_2
147
static PyObject *
148
Robj_tpnew(PyTypeObject *type, PyObject *args, PyObject *kwds)
149
{
150
PyObject *self;
151
152
self = type->tp_alloc(type, 0);
153
return self;
154
}
155
#endif
156
157
/* Type conversion routines. See documentation for details */
158
159
/* These are auxiliaries for a state machine for converting Python
160
list to the coarsest R vector type */
161
#define ANY_T 0
162
#define BOOL_T 1
163
#define INT_T 2
164
#define FLOAT_T 3
165
#define COMPLEX_T 4
166
#define STRING_T 5
167
#define ROBJ_T 6
168
169
static int
170
type_to_int(PyObject *obj)
171
{
172
if (PyBool_Check(obj))
173
return BOOL_T;
174
else if (PyInt_Check(obj))
175
return INT_T;
176
else if (PyFloat_Check(obj))
177
return FLOAT_T;
178
else if (PyComplex_Check(obj))
179
return COMPLEX_T;
180
else if (PyNumber_Check(obj))
181
return ANY_T;
182
else if (PyString_Check(obj))
183
return STRING_T;
184
else if (Robj_Check(obj))
185
return ROBJ_T;
186
else
187
return ANY_T;
188
}
189
190
/* Make a R list or vector from a Python sequence */
191
static SEXP
192
seq_to_R(PyObject *obj)
193
{
194
PyObject *it;
195
SEXP robj, rit;
196
int i, len, state;
197
198
/* This matrix defines what mode a vector should take given what
199
it already contains and a new item
200
201
E.g. Row 0 indicates that if we've seen an any, the vector will
202
always remain an any. Row 3 indicates that if we've seen a
203
float, then seeing an boolean, integer, or float will preserve
204
the vector as a float vector, while seeing a string or an Robj will
205
convert it into an any vector.
206
*/
207
int fsm[7][7] = {
208
{0, 0, 0, 0, 0, 0, 0}, // any
209
{0, 1, 2, 3, 4, 0, 0}, // bool
210
{0, 2, 2, 3, 4, 0, 0}, // int
211
{0, 3, 3, 3, 4, 0, 0}, // float
212
{0, 4, 4, 4, 4, 0, 0}, // complex
213
{0, 0, 0, 0, 0, 5, 0}, // string
214
{0, 0, 0, 0, 0, 0, 6} // RObj
215
};
216
217
len = PySequence_Length(obj);
218
if (len == 0)
219
return R_NilValue;
220
221
PROTECT(robj = NEW_LIST(len));
222
223
state = -1;
224
for (i=0; i<len; i++) {
225
if (!(it = PySequence_GetItem(obj, i)))
226
goto exception;
227
228
if (state < 0)
229
state = type_to_int(it);
230
else
231
state = fsm[state][type_to_int(it)];
232
233
if (!(rit = to_Robj(it)))
234
goto exception;
235
236
SET_VECTOR_ELT(robj, i, rit);
237
Py_XDECREF(it);
238
}
239
240
switch(state)
241
{
242
case INT_T:
243
robj = AS_INTEGER(robj);
244
break;
245
case BOOL_T:
246
robj = AS_LOGICAL(robj);
247
break;
248
case FLOAT_T:
249
robj = AS_NUMERIC(robj);
250
break;
251
case COMPLEX_T:
252
robj = AS_COMPLEX(robj);
253
break;
254
case STRING_T:
255
robj = AS_CHARACTER(robj);
256
break;
257
default:;
258
/* Otherwise, it's either an ANY_T or ROBJ_T - we want ANY */
259
}
260
261
UNPROTECT(1);
262
return robj;
263
264
exception:
265
Py_XDECREF(it);
266
UNPROTECT(1);
267
return NULL;
268
}
269
270
/* Make a R named list or vector from a Python dictionary */
271
static SEXP
272
dict_to_R(PyObject *obj)
273
{
274
int len;
275
PyObject *keys, *values;
276
SEXP robj, names;
277
278
len = PyMapping_Length(obj);
279
if (len == 0)
280
return R_NilValue;
281
282
/* If 'keys' succeed and 'values' fails this leaks */
283
if (!(keys = PyMapping_Keys(obj)))
284
return NULL;
285
if (!(values = PyMapping_Values(obj)))
286
return NULL;
287
288
if (!(robj = seq_to_R(values)))
289
goto fail;
290
if (!(names = seq_to_R(keys)))
291
goto fail;
292
PROTECT(robj);
293
SET_NAMES(robj, names);
294
Py_DECREF(keys);
295
Py_DECREF(values);
296
UNPROTECT(1);
297
298
return robj;
299
300
fail:
301
Py_DECREF(keys);
302
Py_DECREF(values);
303
return NULL;
304
}
305
306
#ifdef WITH_NUMERIC
307
/* Convert a Numeric array to a R array */
308
SEXP
309
to_Rarray(PyObject *o)
310
{
311
PyObject *pytl, *nobj;
312
PyArrayObject *obj;
313
SEXP Rdims, tRdims, Rarray, e;
314
int *dims, i;
315
long tl;
316
317
obj = (PyArrayObject *)o;
318
dims = obj->dimensions;
319
tl = 1;
320
PROTECT(Rdims = allocVector(INTSXP, obj->nd));
321
PROTECT(tRdims = allocVector(INTSXP, obj->nd));
322
for (i=0; i<obj->nd; i++) {
323
if (dims[i] == 0) {
324
UNPROTECT(2);
325
return R_NilValue;
326
}
327
tl *= dims[i];
328
INTEGER(Rdims)[i] = dims[(obj->nd)-i-1];
329
INTEGER(tRdims)[i] = (obj->nd)-i;
330
}
331
332
/* if (!(pytl = PyList_New(1))) */
333
/* goto exception; */
334
/* if (!(it = PyInt_FromLong(tl))) */
335
/* goto exception; */
336
/* if (PyList_SetItem(pytl, 0, it) < 0) */
337
/* goto exception; */
338
339
pytl = Py_BuildValue("[i]", tl);
340
obj = (PyArrayObject *)PyArray_ContiguousFromObject((PyObject *)obj,
341
PyArray_NOTYPE, 0, 0);
342
nobj = PyArray_Reshape(obj, pytl);
343
Py_XDECREF(pytl);
344
Py_XDECREF(obj);
345
if (!nobj)
346
goto exception;
347
348
PROTECT(Rarray = seq_to_R(nobj));
349
Py_XDECREF(nobj);
350
SET_DIM(Rarray, Rdims);
351
352
PROTECT(e = allocVector(LANGSXP, 3));
353
SETCAR(e, aperm);
354
SETCAR(CDR(e), Rarray);
355
SETCAR(CDR(CDR(e)), tRdims);
356
PROTECT(Rarray = do_eval_expr(e));
357
358
UNPROTECT(5);
359
return Rarray;
360
361
exception:
362
UNPROTECT(2);
363
return NULL;
364
}
365
#endif
366
367
/* Convert a Python object to a R object. An Robj is passed w/o
368
* modifications, an object which provides a '.as_r()' method, is
369
* passed as the result of that method */
370
SEXP
371
to_Robj(PyObject *obj)
372
{
373
SEXP robj;
374
Py_complex c;
375
PyObject *to_r_meth;
376
int do_decref = 0;
377
378
if (!obj)
379
return NULL;
380
381
if (obj == Py_None) {
382
return R_NilValue;
383
}
384
385
to_r_meth = PyObject_GetAttrString(obj, "as_r");
386
if (to_r_meth) {
387
obj = PyObject_CallObject(to_r_meth, NULL);
388
Py_DECREF(to_r_meth);
389
if (!obj)
390
return NULL;
391
do_decref = 1;
392
}
393
PyErr_Clear();
394
395
396
if (Robj_Check(obj))
397
{
398
PROTECT(robj = ((RobjObject *)obj)->R_obj);
399
}
400
else if (PyBool_Check(obj))
401
{
402
PROTECT(robj = NEW_LOGICAL(1));
403
LOGICAL_DATA(robj)[0] = (Py_True==obj);
404
}
405
else if (PyInt_Check(obj))
406
{
407
PROTECT(robj = NEW_INTEGER(1));
408
INTEGER_DATA(robj)[0] = (int) PyInt_AsLong(obj);
409
}
410
else if (PyFloat_Check(obj))
411
{
412
PROTECT(robj = NEW_NUMERIC(1));
413
NUMERIC_DATA(robj)[0] = PyFloat_AsDouble(obj);
414
}
415
else if (PyComplex_Check(obj))
416
{
417
PROTECT(robj = NEW_COMPLEX(1));
418
c = PyComplex_AsCComplex(obj);
419
COMPLEX_DATA(robj)[0].r = c.real;
420
COMPLEX_DATA(robj)[0].i = c.imag;
421
}
422
else if (PyString_Check(obj))
423
{
424
PROTECT(robj = NEW_STRING(1));
425
SET_STRING_ELT(robj, 0, COPY_TO_USER_STRING(PyString_AsString(obj)));
426
}
427
#ifdef WITH_NUMERIC
428
//else if (PyArray_Check(obj))
429
else if (use_numeric && PyArray_Check(obj))
430
{
431
PROTECT(robj = to_Rarray(obj));
432
}
433
#endif
434
else if ((PySequence_Check(obj)) &&
435
(PySequence_Size(obj) >= 0))
436
{
437
PROTECT(robj = seq_to_R(obj)); /* No labels */
438
}
439
else if ((PyMapping_Check(obj)) &&
440
(PyMapping_Size(obj) >= 0))
441
{
442
PROTECT(robj = dict_to_R(obj));
443
}
444
else
445
{
446
PyErr_Format(RPyExc_Exception, "cannot convert from type '%s'",
447
obj->ob_type->tp_name);
448
PROTECT(robj = NULL); /* Protected to avoid stack inbalance */
449
}
450
451
if (do_decref)
452
{
453
Py_DECREF(obj);
454
}
455
UNPROTECT(1);
456
return robj;
457
}
458
459
/* Convert a R named vector or list to a Python dictionary */
460
static PyObject *
461
to_PyDict(PyObject *obj, SEXP names)
462
{
463
int len, i;
464
PyObject *it, *dict;
465
char *name;
466
467
if ((len = PySequence_Length(obj)) < 0)
468
return NULL;
469
470
dict = PyDict_New();
471
for (i=0; i<len; i++) {
472
if (!(it = PyList_GetItem(obj, i)))
473
474
return NULL;
475
name = CHAR(STRING_ELT(names, i));
476
if ((PyDict_SetItemString(dict, name, it)) < 0) {
477
return NULL;
478
}
479
}
480
481
return dict;
482
}
483
484
/* We need to transpose the list because R makes array by the
485
* fastest index */
486
static PyObject *
487
ltranspose(PyObject *list, int *dims, int *strides,
488
int pos, int shift, int len)
489
{
490
PyObject *nl, *it;
491
int i;
492
493
if (!(nl = PyList_New(dims[pos])))
494
return NULL;
495
496
if (pos == len-1) {
497
for (i=0; i<dims[pos]; i++) {
498
if (!(it = PyList_GetItem(list, i*strides[pos]+shift)))
499
return NULL;
500
Py_INCREF(it);
501
if (PyList_SetItem(nl, i, it) < 0)
502
return NULL;
503
}
504
return nl;
505
}
506
507
for (i=0; i<dims[pos]; i++) {
508
if (!(it = ltranspose(list, dims, strides, pos+1, shift, len)))
509
return NULL;
510
if (PyList_SetItem(nl, i, it) < 0)
511
return NULL;
512
shift += strides[pos];
513
}
514
515
return nl;
516
}
517
518
/* Convert a Python list to a Python array (in the form of
519
* list of lists of ...) */
520
static PyObject *
521
to_PyArray(PyObject *obj, int *dims, int l)
522
{
523
PyObject *list;
524
int i, c, *strides;
525
526
strides = (int *)PyMem_Malloc(l*sizeof(int));
527
if (!strides)
528
PyErr_NoMemory();
529
530
c = 1;
531
for (i=0; i<l; i++) {
532
strides[i] = c;
533
c *= dims[i];
534
}
535
536
list = ltranspose(obj, dims, strides, 0, 0, l);
537
PyMem_Free(strides);
538
539
return list;
540
}
541
542
/* Convert a Python sequence to a Numeric array */
543
#ifdef WITH_NUMERIC
544
static PyObject *
545
to_PyNumericArray(PyObject *seq, SEXP dim)
546
{
547
PyObject *array, *ret, *dims, *it;
548
int l, i, j;
549
550
array = PyArray_ContiguousFromObject(seq, PyArray_NOTYPE, 0,0);
551
if (!array)
552
return NULL;
553
554
l = GET_LENGTH(dim);
555
dims = PyList_New(l);
556
for (i=0; i<l; i++) {
557
j = INTEGER(dim)[l-i-1];
558
if (j == 0) {
559
Py_DECREF(array);
560
Py_DECREF(dims);
561
Py_INCREF(Py_None);
562
return Py_None;
563
}
564
if (!(it = PyInt_FromLong(j)))
565
return NULL;
566
if (PyList_SetItem(dims, i, it) < 0)
567
return NULL;
568
}
569
570
ret = PyArray_Reshape((PyArrayObject *)array, dims);
571
Py_DECREF(array);
572
Py_DECREF(dims);
573
if (!ret)
574
return NULL;
575
576
array = PyObject_CallFunction(Py_transpose, "O", ret);
577
Py_XDECREF(ret);
578
return array;
579
}
580
#endif
581
582
/* Convert an R object to a 'basic' Python object (mode 2) */
583
/* NOTE: R vectors of length 1 will yield a python scalar */
584
int
585
to_Pyobj_basic(SEXP robj, PyObject **obj)
586
{
587
int status;
588
PyObject *tmp;
589
590
status = to_Pyobj_vector(robj, &tmp, BASIC_CONVERSION);
591
592
if(status==1 && PyList_Check(tmp) && PyList_Size(tmp) == 1)
593
{
594
*obj = PyList_GetItem(tmp, 0);
595
Py_XINCREF(*obj);
596
Py_DECREF(tmp);
597
}
598
else
599
*obj = tmp;
600
601
return status;
602
}
603
604
605
/* Convert an R object to a 'vector' Python object (mode 1) */
606
/* NOTE: R vectors of length 1 will yield a python list of length 1*/
607
int
608
to_Pyobj_vector(SEXP robj, PyObject **obj, int mode)
609
{
610
PyObject *it, *tmp;
611
SEXP names, dim;
612
int len, *integers, i, type;
613
char *strings, *thislevel;
614
double *reals;
615
Rcomplex *complexes;
616
#ifdef WITH_NUMERIC
617
PyObject *array;
618
#endif
619
620
if (!robj)
621
return -1; /* error */
622
623
if (robj == R_NilValue) {
624
Py_INCREF(Py_None);
625
*obj = Py_None;
626
return 1; /* succeed */
627
}
628
629
len = GET_LENGTH(robj);
630
tmp = PyList_New(len);
631
type = TYPEOF(robj);
632
633
for (i=0; i<len; i++) {
634
switch (type)
635
{
636
case LGLSXP:
637
integers = INTEGER(robj);
638
if(integers[i]==NA_INTEGER) /* watch out for NA's */
639
{
640
if (!(it = PyInt_FromLong(integers[i])))
641
return -1;
642
//it = Py_None;
643
}
644
else if (!(it = PyBool_FromLong(integers[i])))
645
return -1;
646
break;
647
case INTSXP:
648
integers = INTEGER(robj);
649
if(isFactor(robj)) {
650
/* Watch for NA's! */
651
if(integers[i]==NA_INTEGER)
652
it = PyString_FromString(CHAR(NA_STRING));
653
else
654
{
655
thislevel = CHAR(STRING_ELT(GET_LEVELS(robj), integers[i]-1));
656
if (!(it = PyString_FromString(thislevel)))
657
return -1;
658
}
659
}
660
else {
661
if (!(it = PyInt_FromLong(integers[i])))
662
return -1;
663
}
664
break;
665
case REALSXP:
666
reals = REAL(robj);
667
if (!(it = PyFloat_FromDouble(reals[i])))
668
return -1;
669
break;
670
case CPLXSXP:
671
complexes = COMPLEX(robj);
672
if (!(it = PyComplex_FromDoubles(complexes[i].r,
673
complexes[i].i)))
674
return -1;
675
break;
676
case STRSXP:
677
if(STRING_ELT(robj, i)==R_NaString)
678
it = PyString_FromString(CHAR(NA_STRING));
679
else
680
{
681
strings = CHAR(STRING_ELT(robj, i));
682
if (!(it = PyString_FromString(strings)))
683
return -1;
684
}
685
break;
686
case LISTSXP:
687
if (!(it = to_Pyobj_with_mode(elt(robj, i), mode)))
688
return -1;
689
break;
690
case VECSXP:
691
if (!(it = to_Pyobj_with_mode(VECTOR_ELT(robj, i), mode)))
692
return -1;
693
break;
694
default:
695
Py_DECREF(tmp);
696
return 0; /* failed */
697
}
698
699
if (PyList_SetItem(tmp, i, it) < 0)
700
return -1;
701
}
702
703
dim = GET_DIM(robj);
704
if (dim != R_NilValue) {
705
#ifdef WITH_NUMERIC
706
if(use_numeric)
707
{
708
array = to_PyNumericArray(tmp, dim);
709
if (array) { /* If the conversion to Numeric succeed.. */
710
*obj = array; /* we are done */
711
Py_DECREF(tmp);
712
return 1;
713
}
714
PyErr_Clear();
715
}
716
#endif
717
len = GET_LENGTH(dim);
718
*obj = to_PyArray(tmp, INTEGER(dim), len);
719
Py_DECREF(tmp);
720
return 1;
721
}
722
723
names = GET_NAMES(robj);
724
if (names == R_NilValue)
725
*obj = tmp;
726
else {
727
*obj = to_PyDict(tmp, names);
728
Py_DECREF(tmp);
729
}
730
return 1;
731
}
732
733
/* Search a conversion procedure from the class attribute */
734
PyObject *
735
from_class_table(SEXP robj)
736
{
737
SEXP rclass;
738
PyObject *lkey, *key, *fun;
739
int i;
740
741
PROTECT(rclass = GET_CLASS(robj));
742
743
fun = NULL;
744
if (rclass != R_NilValue) {
745
746
lkey = to_Pyobj_with_mode(rclass, BASIC_CONVERSION);
747
key = PyList_AsTuple(lkey);
748
if (key) {
749
Py_DECREF(lkey);
750
} else {
751
PyErr_Clear();
752
key = lkey;
753
}
754
fun = PyDict_GetItem(class_table, key);
755
Py_DECREF(key);
756
757
if (!fun) {
758
PyErr_Clear();
759
for (i=0; i<GET_LENGTH(rclass); i++)
760
if ((fun = PyDict_GetItemString(class_table,
761
CHAR(STRING_ELT(rclass, i)))))
762
break;
763
}
764
else
765
Py_INCREF(fun);
766
}
767
UNPROTECT(1);
768
return fun;
769
}
770
771
/* Search a conversion procedure from the proc table */
772
int
773
from_proc_table(SEXP robj, PyObject **fun)
774
{
775
PyObject *procs, *proc, *funs, *res, *obj;
776
int i, l, k, error;
777
778
proc = NULL;
779
procs = PyDict_Keys(proc_table);
780
funs = PyDict_Values(proc_table);
781
l = PyMapping_Size(proc_table);
782
783
obj = (PyObject *)Robj_new(robj, TOP_MODE);
784
785
error = 0;
786
for (i=0; i<l; i++) {
787
proc = PyList_GetItem(procs, i);
788
Py_XINCREF(proc);
789
res = PyObject_CallFunction(proc, "O", obj);
790
if (!res) {
791
error = -1;
792
break;
793
}
794
k = PyObject_IsTrue(res);
795
Py_DECREF(res);
796
if (k) {
797
*fun = PyList_GetItem(funs, i);
798
Py_XINCREF(*fun);
799
break;
800
}
801
}
802
803
Py_DECREF(obj);
804
Py_XDECREF(proc);
805
Py_XDECREF(procs);
806
Py_XDECREF(funs);
807
return error;
808
}
809
810
int
811
to_Pyobj_proc(SEXP robj, PyObject **obj)
812
{
813
PyObject *fun=NULL, *tmp;
814
int i;
815
816
i = from_proc_table(robj, &fun);
817
if (i < 0)
818
return -1; /* an error occurred */
819
820
if (!fun)
821
return 0; /* conversion failed */
822
823
tmp = (PyObject *)Robj_new(robj, TOP_MODE);
824
*obj = PyObject_CallFunction(fun, "O", tmp);
825
Py_DECREF(fun);
826
Py_DECREF(tmp);
827
return 1; /* conversion succeed */
828
}
829
830
/* Convert a Robj to a Python object via the class table (mode 3) */
831
/* See the docs for conversion rules */
832
int
833
to_Pyobj_class(SEXP robj, PyObject **obj)
834
{
835
PyObject *fun, *tmp;
836
837
fun = from_class_table(robj);
838
839
if (!fun)
840
return 0; /* conversion failed */
841
842
tmp = (PyObject *)Robj_new(robj, TOP_MODE);
843
*obj = PyObject_CallFunction(fun, "O", tmp);
844
Py_DECREF(fun);
845
Py_DECREF(tmp);
846
return 1; /* conversion succeed */
847
}
848
849
PyObject *
850
to_Pyobj_with_mode(SEXP robj, int mode)
851
{
852
PyObject *obj;
853
int i;
854
855
switch (mode)
856
{
857
case PROC_CONVERSION:
858
i = to_Pyobj_proc(robj, &obj);
859
if (i<0) return NULL;
860
if (i==1) break;
861
case CLASS_CONVERSION:
862
i = to_Pyobj_class(robj, &obj);
863
if (i<0) return NULL;
864
if (i==1) break;
865
case BASIC_CONVERSION:
866
i = to_Pyobj_basic(robj, &obj);
867
if (i<0) return NULL;
868
if (i==1) break;
869
case VECTOR_CONVERSION:
870
i = to_Pyobj_vector(robj, &obj, mode=VECTOR_CONVERSION);
871
if (i<0) return NULL;
872
if (i==1) break;
873
default:
874
obj = (PyObject *)Robj_new(robj, TOP_MODE);
875
}
876
877
return obj;
878
}
879
880
/* Convert a tuple to arguments for a R function */
881
int
882
make_args(int largs, PyObject *args, SEXP *e)
883
{
884
SEXP r;
885
int i;
886
887
for (i=0; i<largs; i++) {
888
r = to_Robj(PyTuple_GetItem(args, i));
889
if (!r)
890
return 0;
891
SETCAR(*e, r);
892
*e = CDR(*e);
893
}
894
return 1;
895
}
896
897
/* Implements the conversion rules for names. See the 'USING' file. We
898
don't care about '<-' because it doesn't appear in keywords. */
899
char *
900
dotter(char *s)
901
{
902
char *r, *res;
903
int l;
904
905
if (!s)
906
return NULL; /* assume prev PyString_AsString has failed */
907
l = strlen(s);
908
r = (char *)PyMem_Malloc(l+1);
909
if (!r) {
910
PyErr_NoMemory();
911
return NULL;
912
}
913
res = strcpy(r, s);
914
915
if ((l > 1) && (res[l-1] == '_') && (res[l-2] != '_'))
916
res[l-1]=0;
917
918
while ((r=strchr(r, '_')))
919
*r = '.';
920
921
return res;
922
}
923
924
/* Convert a dict to keywords arguments for a R function */
925
int
926
make_kwds(int lkwds, PyObject *kwds, SEXP *e)
927
{
928
SEXP r;
929
char *s;
930
int i;
931
PyObject *citems=NULL, *it;
932
PyObject *kwname;
933
934
if (kwds) {
935
citems = PyMapping_Items(kwds);
936
}
937
938
for (i=0; i<lkwds; i++) {
939
it = PySequence_GetItem(citems, i);
940
if (!it)
941
goto fail;
942
r = to_Robj(PyTuple_GetItem(it, 1));
943
Py_DECREF(it);
944
if (!r)
945
goto fail;
946
947
SETCAR(*e, r);
948
kwname = PyTuple_GetItem(it, 0);
949
if (!kwname)
950
goto fail;
951
if (!PyString_Check(kwname)) {
952
PyErr_SetString(PyExc_TypeError, "keywords must be strings");
953
goto fail;
954
}
955
s = dotter(PyString_AsString(kwname));
956
if (!s)
957
goto fail;
958
959
SET_TAG(*e, Rf_install(s));
960
PyMem_Free(s);
961
*e = CDR(*e);
962
}
963
Py_XDECREF(citems);
964
return 1;
965
966
fail:
967
Py_XDECREF(citems);
968
return 0;
969
}
970
971
972
/* This is the method to call when invoking an 'Robj' */
973
static PyObject *
974
Robj_call(PyObject *self, PyObject *args, PyObject *kwds)
975
{
976
SEXP exp, e, res;
977
int largs, lkwds, conv;
978
PyObject *obj;
979
980
largs = lkwds = 0;
981
if (args)
982
largs = PyObject_Length(args);
983
if (kwds)
984
lkwds = PyObject_Length(kwds);
985
if ((largs<0) || (lkwds<0))
986
return NULL;
987
988
/* A SEXP with the function to call and the arguments and keywords. */
989
PROTECT(exp = allocVector(LANGSXP, largs+lkwds+1));
990
e = exp;
991
SETCAR(e, ((RobjObject *)self)->R_obj);
992
e = CDR(e);
993
994
if (!make_args(largs, args, &e)) {
995
UNPROTECT(1);
996
return NULL;
997
}
998
if (!make_kwds(lkwds, kwds, &e)) {
999
UNPROTECT(1);
1000
return NULL;
1001
}
1002
1003
PROTECT(res = do_eval_expr(exp));
1004
if (!res) {
1005
UNPROTECT(2);
1006
return NULL;
1007
}
1008
1009
if (default_mode < 0)
1010
conv = ((RobjObject *)self)->conversion;
1011
else
1012
conv = default_mode;
1013
1014
obj = to_Pyobj_with_mode(res, conv);
1015
UNPROTECT(2);
1016
1017
PrintWarnings(); /* show any warning messages */
1018
1019
return obj;
1020
}
1021
1022
/* Convert a sequence of (name, value) pairs to arguments to an R
1023
function call */
1024
int
1025
make_argl(int largl, PyObject *argl, SEXP *e)
1026
{
1027
SEXP rvalue;
1028
char *name;
1029
int i;
1030
PyObject *it, *nobj, *value;
1031
1032
if( !PySequence_Check(argl) ) goto fail_arg;
1033
1034
for (i=0; i<largl; i++) {
1035
it = PySequence_GetItem(argl, i);
1036
if(!it) goto fail_arg;
1037
if( PySequence_Size(it) != 2 )
1038
{
1039
Py_DECREF(it);
1040
goto fail_arg;
1041
}
1042
nobj = PySequence_GetItem(it, 0);
1043
1044
/* Name can be a string, None, or NULL, error otherwise. */
1045
if (PyString_Check(nobj))
1046
{
1047
name = dotter(PyString_AsString(nobj));
1048
Py_DECREF(nobj);
1049
}
1050
else if (nobj == Py_None)
1051
{
1052
name = NULL;
1053
Py_DECREF(nobj);
1054
}
1055
else if(nobj == NULL)
1056
{
1057
name = NULL;
1058
}
1059
else
1060
{
1061
Py_DECREF(nobj);
1062
goto fail_arg;
1063
}
1064
1065
/* Value can be anything. */
1066
value = PySequence_GetItem(it, 1);
1067
if (!value)
1068
{
1069
PyMem_Free(name);
1070
goto fail;
1071
}
1072
1073
rvalue = to_Robj(value);
1074
Py_DECREF(value);
1075
1076
Py_DECREF(it);
1077
1078
/* Add parameter value to call */
1079
SETCAR(*e, rvalue);
1080
1081
/* Add name (if present) */
1082
if (name && strlen(name)>0)
1083
{
1084
SET_TAG(*e, Rf_install(name));
1085
PyMem_Free(name);
1086
}
1087
1088
/* Move index to new end of call */
1089
*e = CDR(*e);
1090
}
1091
return 1;
1092
1093
fail_arg:
1094
PyErr_SetString(PyExc_ValueError,
1095
"Argument must be a sequence of (\"name\", value) pairs.\n");
1096
fail:
1097
return 0;
1098
}
1099
1100
/* Methods for the 'Robj' type */
1101
1102
/* Explicitly call an R object with a list containing (name, value) *
1103
* argument pairs. 'name' can be None or '' to provide unnamed
1104
* arguments. This function is necessary when the *order* of named
1105
* arguments needs to be preserved.
1106
*/
1107
1108
static PyObject *
1109
Robj_lcall(PyObject *self, PyObject *args)
1110
{
1111
SEXP exp, e, res;
1112
int largs, largl, conv;
1113
PyObject *obj, *argl;
1114
1115
/* Check arguments, there should be *exactly one* unnamed sequence. */
1116
largs = 0;
1117
if (args)
1118
largs = PyObject_Length(args);
1119
if (largs<0)
1120
return NULL;
1121
1122
if(largs != 1 || !PySequence_Check(args) )
1123
{
1124
PyErr_SetString(PyExc_ValueError,
1125
"Argument must be a sequence of (\"name\", value) pairs.\n");
1126
return NULL;
1127
}
1128
1129
// extract our one argument
1130
argl = PySequence_GetItem(args, 0);
1131
Py_DECREF(args);
1132
1133
largl = 0;
1134
if (argl)
1135
largl = PyObject_Length(argl);
1136
if (largl<0)
1137
return NULL;
1138
1139
// A SEXP with the function to call and the arguments
1140
PROTECT(exp = allocVector(LANGSXP, largl+1));
1141
e = exp;
1142
SETCAR(e, ((RobjObject *)self)->R_obj);
1143
e = CDR(e);
1144
1145
// Add the arguments to the SEXP
1146
if (!make_argl(largl, argl, &e)) {
1147
UNPROTECT(1);
1148
return NULL;
1149
}
1150
1151
// Evaluate
1152
PROTECT(res = do_eval_expr(exp));
1153
if (!res) {
1154
UNPROTECT(2);
1155
return NULL;
1156
}
1157
1158
// Convert
1159
if (default_mode < 0)
1160
conv = ((RobjObject *)self)->conversion;
1161
else
1162
conv = default_mode;
1163
1164
obj = to_Pyobj_with_mode(res, conv);
1165
UNPROTECT(2);
1166
1167
// Return
1168
return obj;
1169
}
1170
1171
1172
/* Without args return the value of the conversion flag. With an
1173
argument set the conversion flag to the truth value of the argument. */
1174
static PyObject *
1175
Robj_autoconvert(PyObject *self, PyObject *args, PyObject *kwds)
1176
{
1177
PyObject *obj;
1178
int conversion=-2;
1179
static char *kwlist[] = {"val", 0};
1180
1181
if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:autoconvert", kwlist,
1182
&conversion))
1183
return NULL;
1184
1185
if (conversion > TOP_MODE) {
1186
PyErr_SetString(PyExc_ValueError, "wrong mode");
1187
return NULL;
1188
}
1189
1190
if (conversion == -2) {
1191
obj = PyInt_FromLong((long)((RobjObject *)self)->conversion);
1192
} else {
1193
((RobjObject *)self)->conversion = conversion;
1194
obj = Py_None;
1195
Py_XINCREF(obj);
1196
}
1197
1198
return obj;
1199
}
1200
1201
static PyObject *
1202
Robj_as_py(PyObject *self, PyObject *args, PyObject *kwds)
1203
{
1204
PyObject *obj;
1205
static char *kwlist[] = {"mode", 0};
1206
int conv=default_mode;
1207
1208
if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:as_py", kwlist,
1209
&conv))
1210
return NULL;
1211
1212
if (conv <= -2 || conv > TOP_MODE) {
1213
PyErr_SetString(PyExc_ValueError, "wrong mode");
1214
return NULL;
1215
}
1216
1217
if (conv < 0)
1218
conv = TOP_MODE;
1219
1220
obj = to_Pyobj_with_mode(((RobjObject *)self)->R_obj, conv);
1221
return obj;
1222
}
1223
1224
static PyMethodDef Robj_methods[] = {
1225
{"autoconvert", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS},
1226
{"local_mode", (PyCFunction)Robj_autoconvert, METH_VARARGS|METH_KEYWORDS},
1227
{"as_py", (PyCFunction)Robj_as_py, METH_VARARGS|METH_KEYWORDS},
1228
{"lcall", (PyCFunction)Robj_lcall, METH_VARARGS},
1229
{NULL, NULL} /* sentinel */
1230
};
1231
1232
/* Sequence protocol implementation */
1233
1234
/* len(a) */
1235
static int
1236
Robj_len(PyObject *a)
1237
{
1238
SEXP e, robj;
1239
1240
PROTECT(e = allocVector(LANGSXP, 2));
1241
SETCAR(e, length);
1242
SETCAR(CDR(e), ((RobjObject *)a)->R_obj);
1243
1244
if (!(robj = do_eval_expr(e))) {
1245
UNPROTECT(1);
1246
return -1;
1247
}
1248
1249
UNPROTECT(1);
1250
return INTEGER_DATA(robj)[0];
1251
}
1252
1253
/* a[i] = v */
1254
static int
1255
Robj_ass_item(PyObject *a, int i, PyObject *v)
1256
{
1257
SEXP e, ri, robj;
1258
1259
PROTECT(e = allocVector(LANGSXP, 4));
1260
ri = NEW_INTEGER(1);
1261
INTEGER_DATA(ri)[0] = i+1;
1262
SETCAR(e, set_item);
1263
SETCAR(CDR(e), ((RobjObject *)a)->R_obj);
1264
SETCAR(CDR(CDR(e)), ri);
1265
SETCAR(CDR(CDR(CDR(e))), to_Robj(v));
1266
1267
if (!(robj = do_eval_expr(e))) {
1268
UNPROTECT(1);
1269
return -1;
1270
}
1271
1272
((RobjObject *)a)->R_obj = robj;
1273
UNPROTECT(1);
1274
return 0;
1275
}
1276
1277
/* a[i] */
1278
static PyObject *
1279
Robj_item(PyObject *a, int i)
1280
{
1281
SEXP ri, robj, e;
1282
PyObject *obj;
1283
int len, c;
1284
1285
if ((len = Robj_len(a)) < 0)
1286
return NULL;
1287
if (i >= len || i < 0) {
1288
PyErr_SetString(PyExc_IndexError, "R object index out of range");
1289
return NULL;
1290
}
1291
1292
PROTECT(ri = NEW_INTEGER(1));
1293
INTEGER_DATA(ri)[0] = i+1;
1294
PROTECT(e = allocVector(LANGSXP, 3));
1295
SETCAR(e, get_item);
1296
SETCAR(CDR(e), ((RobjObject *)a)->R_obj);
1297
SETCAR(CDR(CDR(e)), ri);
1298
1299
if (!(robj = do_eval_expr(e))) {
1300
UNPROTECT(2);
1301
return NULL;
1302
}
1303
1304
UNPROTECT(2);
1305
1306
/* If there is a default mode, use it; otherwise, use the top mode. */
1307
if (default_mode < 0)
1308
c = TOP_MODE;
1309
else
1310
c = default_mode;
1311
obj = to_Pyobj_with_mode(robj, c);
1312
return obj;
1313
}
1314
1315
/* We should implement sq_slice, sq_contains ... */
1316
static PySequenceMethods Robj_as_sequence = {
1317
(inquiry)Robj_len, /* sq_length */
1318
0, /* sq_concat */
1319
0, /* sq_repeat */
1320
(intargfunc)Robj_item, /* sq_item */
1321
0, /* sq_slice */
1322
(intobjargproc)Robj_ass_item, /* sq_ass_item */
1323
0, /* sq_ass_slice */
1324
0, /* sq_contains */
1325
};
1326
1327
1328
/* The 'Robj' table. When compiled under Python 2.2, the type 'Robj'
1329
is subclassable. */
1330
1331
#ifdef PRE_2_2
1332
static PyObject *
1333
Robj_getattr(RobjObject *self, char *name)
1334
{
1335
return Py_FindMethod(Robj_methods, (PyObject *)self, name);
1336
}
1337
#endif
1338
1339
PyTypeObject Robj_Type = {
1340
/* The ob_type field must be initialized in the module init function
1341
* to be portable to Windows without using C++. */
1342
#if defined(PRE_2_2) || defined(_WIN32) // Matjaz
1343
PyObject_HEAD_INIT(NULL)
1344
#else
1345
PyObject_HEAD_INIT(&PyType_Type)
1346
#endif
1347
0, /*ob_size*/
1348
"Robj", /*tp_name*/
1349
sizeof(RobjObject), /*tp_basicsize*/
1350
0, /*tp_itemsize*/
1351
/* methods */
1352
(destructor)Robj_dealloc, /*tp_dealloc*/
1353
0, /*tp_print*/
1354
#ifdef PRE_2_2
1355
(getattrfunc)Robj_getattr,
1356
#else
1357
0,
1358
#endif
1359
0,
1360
0, /*tp_compare*/
1361
0, /*tp_repr*/
1362
0, /*tp_as_number*/
1363
&Robj_as_sequence, /*tp_as_sequence*/
1364
0, /*tp_as_mapping*/
1365
0, /*tp_hash*/
1366
(ternaryfunc)Robj_call, /*tp_call*/
1367
0, /*tp_str*/
1368
#if defined(PRE_2_2) || defined(_WIN32)
1369
0,
1370
#else
1371
PyObject_GenericGetAttr, /*tp_getattro*/
1372
#endif
1373
0, /*tp_setattro*/
1374
0, /*tp_as_buffer*/
1375
#ifdef PRE_2_2
1376
0,
1377
#else
1378
Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/
1379
#endif
1380
0, /*tp_doc*/
1381
0, /*tp_traverse*/
1382
#ifndef PRE_2_2
1383
0, /*tp_clear*/
1384
0, /*tp_richcompare*/
1385
0, /*tp_weaklistoffset*/
1386
0, /*tp_iter*/
1387
0, /*tp_iternext*/
1388
Robj_methods, /*tp_methods*/
1389
0, /*tp_members*/
1390
0, /*tp_getset*/
1391
0, /*tp_base*/
1392
0, /*tp_dict*/
1393
0, /*tp_descr_get*/
1394
0, /*tp_descr_set*/
1395
0, /*tp_dictoffset*/
1396
0, /*tp_init*/
1397
#ifdef _WIN32
1398
0, /*tp_alloc*/
1399
#else
1400
PyType_GenericAlloc, /*tp_alloc*/
1401
#endif
1402
Robj_tpnew, /*tp_new*/
1403
0, /*tp_free*/
1404
0, /*tp_is_gc*/
1405
#endif
1406
};
1407
1408
1409
/* Module functions */
1410
1411
/* Obtain an R object via its name. 'autoconvert' is the keyword to
1412
set the autoconversion flag. */
1413
static PyObject *
1414
get_fun(PyObject *self, PyObject *args, PyObject *kwds)
1415
{
1416
char *obj_str;
1417
int conversion=TOP_MODE;
1418
SEXP robj;
1419
1420
static char *kwlist[] = {"name", "autoconvert", 0};
1421
if (!PyArg_ParseTupleAndKeywords(args, kwds, "s|i:get", kwlist,
1422
&obj_str, &conversion))
1423
return NULL;
1424
1425
robj = get_fun_from_name(obj_str);
1426
if (!robj)
1427
return NULL;
1428
1429
return (PyObject *)Robj_new(robj, conversion);
1430
}
1431
1432
static PyObject *
1433
set_mode(PyObject *self, PyObject *args)
1434
{
1435
int i=-1;
1436
1437
if (!PyArg_ParseTuple(args, "i:set_mode", &i))
1438
return NULL;
1439
1440
if (i<-1 || i>TOP_MODE) {
1441
PyErr_SetString(PyExc_ValueError, "wrong mode");
1442
return NULL;
1443
}
1444
1445
default_mode = i;
1446
Py_INCREF(Py_None);
1447
return Py_None;
1448
}
1449
1450
static PyObject *
1451
get_mode(PyObject *self, PyObject *args)
1452
{
1453
if (!PyArg_ParseTuple(args, ":get_mode"))
1454
return NULL;
1455
1456
return PyInt_FromLong(default_mode);
1457
}
1458
1459
static PyObject *
1460
r_events(PyObject *self, PyObject *args, PyObject *kwds)
1461
#ifdef _WIN32
1462
{
1463
return NULL;
1464
}
1465
#else
1466
{
1467
fd_set *what;
1468
int usec=10000;
1469
1470
static char *kwlist[] = {"usec", 0};
1471
if (!PyArg_ParseTupleAndKeywords(args, kwds, "|i:r_events",
1472
kwlist, &usec))
1473
return NULL;
1474
1475
if (R_interact) {
1476
Py_BEGIN_ALLOW_THREADS
1477
what = R_checkActivity(usec, 0);
1478
R_runHandlers(R_InputHandlers, what);
1479
Py_END_ALLOW_THREADS
1480
}
1481
1482
Py_INCREF(Py_None);
1483
return Py_None;
1484
}
1485
#endif
1486
1487
void
1488
stop_events(void)
1489
{
1490
PyObject *o;
1491
1492
if (!rpy_dict)
1493
return;
1494
1495
if (!r_lock)
1496
r_lock = PyDict_GetItemString(rpy_dict, "_r_lock");
1497
1498
o = PyObject_CallMethod(r_lock, "acquire", NULL);
1499
Py_XDECREF(o);
1500
}
1501
1502
void
1503
start_events(void)
1504
{
1505
PyObject *o;
1506
1507
if (!rpy_dict)
1508
return;
1509
1510
if (!r_lock)
1511
r_lock = PyDict_GetItemString(rpy_dict, "_r_lock");
1512
1513
o = PyObject_CallMethod(r_lock, "release", NULL);
1514
Py_XDECREF(o);
1515
}
1516
1517
1518
/*
1519
* Based on code from Rstd_CleanUp();
1520
* from src/unix/sys-std.c
1521
*/
1522
1523
void r_finalize(void)
1524
{
1525
unsigned char buf[1024];
1526
char * tmpdir;
1527
1528
R_dot_Last();
1529
R_RunExitFinalizers();
1530
CleanEd();
1531
KillAllDevices();
1532
if((tmpdir = getenv("R_SESSION_TMPDIR"))) {
1533
snprintf((char *)buf, 1024, "rm -rf %s", tmpdir);
1534
R_system((char *)buf);
1535
}
1536
1537
PrintWarnings(); /* from device close and .Last */
1538
R_gc(); /* Remove any remaining R objects from memory */
1539
}
1540
1541
1542
static PyObject *
1543
r_cleanup(void)
1544
{
1545
r_cleanup();
1546
Py_INCREF(Py_None);
1547
return Py_None;
1548
}
1549
1550
#ifdef WITH_NUMERIC
1551
static void
1552
init_numeric(void)
1553
{
1554
PyObject *multiarray, *dict;
1555
1556
if(use_numeric)
1557
{
1558
import_array();
1559
multiarray = PyImport_ImportModule("multiarray");
1560
if (multiarray) {
1561
dict = PyModule_GetDict(multiarray);
1562
if (dict)
1563
Py_transpose = PyDict_GetItemString(dict, "transpose");
1564
}
1565
}
1566
}
1567
#endif
1568
1569
static PyObject *
1570
r_init(PyObject *self, PyObject *args)
1571
{
1572
static int first=1;
1573
int i;
1574
1575
if (!PyArg_ParseTuple(args, "i:r_init", &i))
1576
return NULL;
1577
use_numeric = i;
1578
1579
#ifdef WITH_NUMERIC
1580
if(use_numeric)
1581
init_numeric();
1582
#endif
1583
1584
if(first==1)
1585
{
1586
first=0;
1587
Py_INCREF(Py_None);
1588
return Py_None;
1589
}
1590
else
1591
{
1592
PyErr_SetString(PyExc_RuntimeError, "Only one R object may be instantiated per session");
1593
return NULL;
1594
}
1595
}
1596
1597
/* List of functions defined in the module */
1598
static PyMethodDef rpy_methods[] = {
1599
{"get_fun", (PyCFunction)get_fun, METH_VARARGS | METH_KEYWORDS},
1600
{"set_mode", (PyCFunction)set_mode, METH_VARARGS},
1601
{"get_mode", (PyCFunction)get_mode, METH_VARARGS},
1602
{"set_output", (PyCFunction)set_output, METH_VARARGS},
1603
{"set_input", (PyCFunction)set_input, METH_VARARGS},
1604
{"set_showfiles", (PyCFunction)set_showfiles, METH_VARARGS},
1605
{"get_output", (PyCFunction)get_output, METH_VARARGS},
1606
{"get_input", (PyCFunction)get_input, METH_VARARGS},
1607
{"get_showfiles", (PyCFunction)get_showfiles, METH_VARARGS},
1608
{"r_events", (PyCFunction)r_events, METH_VARARGS | METH_KEYWORDS},
1609
{"r_cleanup", (PyCFunction)r_cleanup, METH_NOARGS},
1610
{"r_init", (PyCFunction)r_init, METH_VARARGS},
1611
{NULL, NULL} /* sentinel */
1612
};
1613
1614
#ifdef _WIN32
1615
static void char_message( char *s )
1616
{
1617
if (!s) return;
1618
R_WriteConsole(s, strlen(s));
1619
}
1620
1621
static int char_yesnocancel( char *s )
1622
{
1623
return 1;
1624
}
1625
1626
static void
1627
RPyBusy( int which )
1628
{
1629
/* set a busy cursor ... in which = 1, unset if which = 0 */
1630
}
1631
1632
static void
1633
RPyDoNothing( void )
1634
{
1635
}
1636
1637
/* initialise embedded R; based on rproxy_impl.c from the R distribution */
1638
static void
1639
init_embedded_win32( void ) {
1640
structRstart rp;
1641
Rstart Rp = &rp;
1642
char Rversion[25];
1643
int index;
1644
1645
1646
snprintf( Rversion, 25, "%s.%s", R_MAJOR, R_MINOR );
1647
if( strcmp( getDLLVersion(), Rversion ) != 0 ) {
1648
PyErr_SetString( PyExc_ImportError, "R.DLL version does not match" );
1649
return;
1650
}
1651
1652
R_DefParams(Rp);
1653
1654
/* set R_HOME */
1655
Rp->rhome = RHOME;
1656
1657
index = strlen(RUSER) - 1;
1658
1659
if (RUSER[index] == '/' || RUSER[index] == '\\')
1660
RUSER[index] = '\0';
1661
1662
Rp->home = RUSER;
1663
Rp->CharacterMode = LinkDLL;
1664
1665
Rp->ReadConsole = (blah1) RPy_ReadConsole; // Matjaz
1666
Rp->WriteConsole = (blah2) RPy_WriteConsole; // Matjaz
1667
1668
Rp->CallBack = (blah3) RPyDoNothing;
1669
#if R_VERSION < 0x20100
1670
Rp->message = char_message;
1671
Rp->yesnocancel = char_yesnocancel;
1672
Rp->busy = RPyBusy;
1673
#else
1674
Rp->ShowMessage = char_message;
1675
Rp->YesNoCancel = char_yesnocancel;
1676
Rp->Busy = RPyBusy;
1677
#endif
1678
1679
Rp->R_Quiet = TRUE;
1680
1681
/* run as "interactive", so server won't be killed after an error */
1682
Rp->R_Slave = Rp->R_Verbose = 0;
1683
Rp->R_Interactive = TRUE;
1684
Rp->RestoreAction = SA_RESTORE; /* no restore */
1685
Rp->SaveAction = SA_NOSAVE; /* no save */
1686
1687
#if R_VERSION < 0x20000 // pre-R-2.0.0
1688
1689
Rp->CommandLineArgs = NULL;
1690
Rp->NumCommandLineArgs = 0;
1691
#else
1692
R_set_command_line_arguments(0, NULL);
1693
#endif
1694
R_SetParams(Rp); /* so R_ShowMessage is set */
1695
R_SizeFromEnv(Rp);
1696
1697
R_SetParams(Rp);
1698
1699
setup_term_ui();
1700
setup_Rmainloop();
1701
}
1702
#endif
1703
1704
/* Initialization function for the module */
1705
DL_EXPORT(void)
1706
INIT_RPY(void)
1707
{
1708
PyObject *m, *d;
1709
PyOS_sighandler_t old_int;
1710
#ifndef _WIN32
1711
char *defaultargv[] = {"rpy", "-q", "--vanilla"};
1712
PyOS_sighandler_t old_usr1, old_usr2;
1713
#endif
1714
SEXP interact;
1715
1716
/* Get path and version information from environment */
1717
strncpy(RHOME, getenv("RPY_RHOME"), BUFSIZ);
1718
strncpy(RVERSION, getenv("RPY_RVERSION"), BUFSIZ);
1719
strncpy(RVER, getenv("RPY_RVER"), BUFSIZ);
1720
strncpy(RUSER, getenv("RPY_RUSER"), BUFSIZ);
1721
1722
if( !strlen(RHOME) || !strlen(RVERSION) || !strlen(RVER) || !strlen(RUSER))
1723
{
1724
PyErr_Format(RPyExc_Exception,
1725
"Unable to load R path or version information");
1726
return;
1727
}
1728
1729
Robj_Type.ob_type = &PyType_Type;
1730
#if defined( _WIN32 ) && ! defined( PRE_2_2 )
1731
Robj_Type.tp_getattro = PyObject_GenericGetAttr;
1732
Robj_Type.tp_alloc = PyType_GenericAlloc;
1733
#endif
1734
1735
//m = Py_InitModule(MacroQuote(RPY_SHNAME), rpy_methods);
1736
m = Py_InitModule(RPY_SHNAME, rpy_methods);
1737
d = PyModule_GetDict(m);
1738
1739
/* Save this interpreter */
1740
PyEval_InitThreads();
1741
my_interp = PyThreadState_Get()->interp;
1742
1743
/* Save the Python signal handlers. If R inserts its handlers, we
1744
cannot return to the Python interpreter. */
1745
old_int = PyOS_getsig(SIGINT);
1746
python_sigint = old_int;
1747
#ifndef _WIN32
1748
old_usr1 = PyOS_getsig(SIGUSR1);
1749
old_usr2 = PyOS_getsig(SIGUSR2);
1750
#endif
1751
1752
#ifdef _WIN32
1753
init_embedded_win32();
1754
#else
1755
Rf_initEmbeddedR( sizeof(defaultargv) / sizeof(defaultargv[0]),
1756
defaultargv);
1757
#endif
1758
1759
/* Restore Python handlers */
1760
PyOS_setsig(SIGINT, old_int);
1761
#ifndef _WIN32
1762
PyOS_setsig(SIGUSR1, old_usr1);
1763
PyOS_setsig(SIGUSR2, old_usr2);
1764
#endif
1765
1766
/* The new exception */
1767
RPyExc_Exception = PyErr_NewException("rpy.RException", NULL, NULL);
1768
if (RPyExc_Exception)
1769
PyDict_SetItemString(d, "RException", RPyExc_Exception);
1770
1771
// The conversion table
1772
class_table = PyDict_New();
1773
proc_table = PyDict_New();
1774
PyDict_SetItemString(d, "__class_table__", class_table);
1775
PyDict_SetItemString(d, "__proc_table__", proc_table);
1776
1777
// The globals R objects for the sequence protocol
1778
get_item = get_fun_from_name("[");
1779
set_item = get_fun_from_name("[<-");
1780
length = get_fun_from_name("length");
1781
1782
// Function to transpose arrays
1783
aperm = get_fun_from_name("aperm");
1784
1785
// Initialize the list of protected objects
1786
R_References = R_NilValue;
1787
SET_SYMVALUE(install("R.References"), R_References);
1788
1789
// Initialize the default mode
1790
default_mode = -1;
1791
1792
// Check whether R is interactive or no
1793
interact = do_eval_fun("interactive");
1794
R_interact = INTEGER(interact)[0];
1795
1796
// I/O routines
1797
init_io_routines();
1798
1799
1800
1801
rpy = PyImport_ImportModule("rpy");
1802
rpy_dict = PyModule_GetDict(rpy);
1803
// r_lock = PyDict_GetItemString(rpy_dict, "_r_lock");
1804
// PyObject_Print(r_lock, stderr, Py_PRINT_RAW);
1805
r_lock = NULL;
1806
1807
if( Py_AtExit( r_finalize ) )
1808
{
1809
fprintf(stderr, "Warning: Unable to set R finalizer.");
1810
fflush(stderr);
1811
}
1812
1813
1814
}
1815
1816
Loggerhead is a web-based interface for Breezy
Version: 2.0.1