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