rsruby 0.4.0

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1,74 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ #ifndef R_RUBY_CONVERTERS_H
33
+ #define R_RUBY_CONVERTERS_H
34
+
35
+ #include "rsruby.h"
36
+
37
+ //Converters for Ruby to R
38
+ SEXP ruby_to_R(VALUE val);
39
+
40
+ static SEXP array_to_R(VALUE obj);
41
+ static SEXP hash_to_R(VALUE obj);
42
+ static int type_to_int(VALUE obj);
43
+
44
+ //Converters for R to Ruby
45
+ VALUE to_ruby_with_mode(SEXP robj, int mode);
46
+
47
+ int to_ruby_basic(SEXP robj, VALUE *obj);
48
+ int to_ruby_vector(SEXP robj, VALUE *obj, int mode);
49
+ int to_ruby_proc(SEXP robj, VALUE *obj);
50
+ int to_ruby_class(SEXP robj, VALUE *obj);
51
+ int from_proc_table(SEXP robj, VALUE *fun);
52
+ VALUE from_class_table(SEXP robj);
53
+
54
+ static VALUE to_ruby_hash(VALUE obj, SEXP names);
55
+ static VALUE to_ruby_array(VALUE obj, int *dims, int l);
56
+
57
+ static VALUE ltranspose(VALUE list, int *dims, int *strides,
58
+ int pos, int shift, int len);
59
+
60
+ //Macros for quick checks
61
+ #define Robj_Check(v) (rb_obj_is_instance_of(v,rb_const_get(rb_cObject,rb_intern("RObj"))))
62
+ #define RubyComplex_Check(v) (rb_obj_is_instance_of(v,rb_const_get(rb_cObject,rb_intern("Complex"))))
63
+
64
+ /* These are auxiliaries for a state machine for converting Python
65
+ list to the coarsest R vector type */
66
+ #define ANY_T 0
67
+ #define BOOL_T 1
68
+ #define INT_T 2
69
+ #define FLOAT_T 3
70
+ #define COMPLEX_T 4
71
+ #define STRING_T 5
72
+ #define ROBJ_T 6
73
+
74
+ #endif
@@ -0,0 +1,138 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ #include <rsruby.h>
33
+ #include <R_eval.h>
34
+
35
+ /* Abort the current R computation due to a SIGINT */
36
+ void interrupt_R(int signum)
37
+ {
38
+ //interrupted = 1;
39
+ //error("Interrupted");
40
+ }
41
+
42
+
43
+ /* Evaluate a SEXP. It must be constructed by hand. It raises a Ruby
44
+ exception if an error ocurred in the evaluation */
45
+ SEXP do_eval_expr(SEXP e) {
46
+ SEXP res;
47
+ VALUE rb_eRException;
48
+ int error = 0;
49
+
50
+ res = R_tryEval(e, R_GlobalEnv, &error);
51
+
52
+ if (error) {
53
+ //if (interrupted) {
54
+ // rb_raise(rb_eInterrupt);
55
+ //}
56
+ //else
57
+ rb_eRException = rb_const_get(rb_cObject,
58
+ rb_intern("RException"));
59
+ rb_raise(rb_eRException, get_last_error_msg());
60
+ return NULL;
61
+ }
62
+
63
+ return res;
64
+
65
+ }
66
+
67
+ /* Evaluate a function given by a name (without arguments) */
68
+ SEXP do_eval_fun(char *name) {
69
+ SEXP exp, fun, res;
70
+
71
+ fun = get_fun_from_name(name);
72
+ if (!fun)
73
+ return NULL;
74
+
75
+ PROTECT(fun);
76
+ PROTECT(exp = allocVector(LANGSXP, 1));
77
+ SETCAR(exp, fun);
78
+
79
+ PROTECT(res = do_eval_expr(exp));
80
+ UNPROTECT(3);
81
+ return res;
82
+ }
83
+
84
+ /*
85
+ * Get an R **function** object by its name. When not found, an exception is
86
+ * raised. The checking of the length of the identifier is needed to
87
+ * avoid R raising an error.
88
+ */
89
+ SEXP get_fun_from_name(char *ident) {
90
+ SEXP obj;
91
+
92
+ /* For R not to throw an error, we must check the identifier is
93
+ neither null nor greater than MAXIDSIZE */
94
+ if (!*ident) {
95
+ rb_raise(rb_eRuntimeError, "Attempt to use zero-length variable name");
96
+ return NULL;
97
+ }
98
+ if (strlen(ident) > MAXIDSIZE) {
99
+ rb_raise(rb_eRuntimeError, "symbol print-name too long");
100
+ return NULL;
101
+ }
102
+
103
+ #if R_VERSION < 0x20000
104
+ obj = Rf_findVar(Rf_install(ident), R_GlobalEnv);
105
+ #else
106
+ /*
107
+ * For R-2.0.0 and later, it is necessary to use findFun to get
108
+ * functions. Unfortunately, calling findFun on an undefined name
109
+ * causes a segfault!
110
+ *
111
+ * Solution:
112
+ *
113
+ * 1) Call findVar on the name
114
+ *
115
+ * 2) If something has the name, call findFun
116
+ *
117
+ * 3) Raise an error if either step 1 or 2 fails.
118
+ */
119
+ obj = Rf_findVar(Rf_install(ident), R_GlobalEnv);
120
+
121
+ if (obj != R_UnboundValue)
122
+ obj = Rf_findFun(Rf_install(ident), R_GlobalEnv);
123
+ #endif
124
+
125
+ if (obj == R_UnboundValue) {
126
+ rb_raise(rb_eNoMethodError, "R Function \"%s\" not found", ident);
127
+ return NULL;
128
+ }
129
+ return obj;
130
+ }
131
+
132
+ /* Obtain the text of the last R error message */
133
+ char *get_last_error_msg() {
134
+ SEXP msg;
135
+
136
+ msg = do_eval_fun("geterrmessage");
137
+ return CHARACTER_VALUE(msg);
138
+ }
@@ -0,0 +1,40 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ /* R Evaluation */
33
+ SEXP do_eval_expr(SEXP e);
34
+ SEXP do_eval_fun(char *);
35
+ SEXP get_fun_from_name(char *);
36
+
37
+ /* Interrupt the R interpreter */
38
+ void interrupt_R(int);
39
+
40
+ char *get_last_error_msg(void);
@@ -0,0 +1,20 @@
1
+ require 'mkmf'
2
+ require 'rbconfig'
3
+
4
+ dir_config('R')
5
+ unless have_library("R")
6
+ $stderr.puts "\nERROR: Cannot find the R library, aborting."
7
+ exit 1
8
+ end
9
+ unless have_header("R.h")
10
+ $stderr.puts "\nERROR: Cannot find the R header, aborting."
11
+ exit 1
12
+ end
13
+
14
+ create_makefile("rsruby")
15
+ #create_makefile("robj")
16
+
17
+ File.open("Makevars","w") do |file|
18
+ file.puts "PKG_CPPFLAGS = -I#{Config::CONFIG["archdir"]} -D_R_=1 -DUSE_R=1 -DUSE_TOPLEVEL_EXEC=1"
19
+ file.puts "PKG_LIBS = #{Config::CONFIG["LIBRUBYARG_SHARED"]}"
20
+ end
data/ext/rsruby/robj.c ADDED
@@ -0,0 +1,169 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ #include "rsruby.h"
33
+
34
+ /* Methods for the 'Robj' type */
35
+
36
+ /* Explicitly call an R object with a list containing (name, value) *
37
+ * argument pairs. 'name' can be None or '' to provide unnamed
38
+ * arguments. This function is necessary when the *order* of named
39
+ * arguments needs to be preserved.
40
+ */
41
+
42
+ VALUE RObj_lcall(VALUE self, VALUE args){
43
+ SEXP exp, e, res;
44
+ SEXP r_obj;
45
+ int conv, default_mode;
46
+ VALUE obj;
47
+
48
+ //Ensure we have an array
49
+ args = rb_check_array_type(args);
50
+
51
+ // A SEXP with the function to call and the arguments
52
+ PROTECT(exp = allocVector(LANGSXP, (RARRAY(args)->len)+1));
53
+ e = exp;
54
+
55
+ Data_Get_Struct(self, struct SEXPREC, r_obj);
56
+
57
+ SETCAR(e, r_obj);
58
+ e = CDR(e);
59
+
60
+ // Add the arguments to the SEXP
61
+ if (!make_argl(args, &e)) {
62
+ UNPROTECT(1);
63
+ return Qnil;
64
+ }
65
+
66
+ // Evaluate
67
+ PROTECT(res = do_eval_expr(exp));
68
+ if (!res) {
69
+ UNPROTECT(2);
70
+ return Qnil;
71
+ }
72
+
73
+ default_mode = NUM2INT(rb_cvar_get(rb_const_get(rb_cObject,
74
+ rb_intern("RSRuby")),
75
+ rb_intern("@@default_mode")));
76
+
77
+ // Convert
78
+ if (default_mode < 0){
79
+ conv = NUM2INT(rb_iv_get(self,"@conversion"));
80
+ } else {
81
+ conv = default_mode;
82
+ }
83
+
84
+ obj = to_ruby_with_mode(res, conv);
85
+
86
+ UNPROTECT(2);
87
+
88
+ return obj;
89
+ }
90
+
91
+ /* Convert a sequence of (name, value) pairs to arguments to an R
92
+ function call */
93
+ int
94
+ make_argl(VALUE args, SEXP *e)
95
+ {
96
+ SEXP rvalue;
97
+ int i;
98
+ VALUE pair, name, value;
99
+
100
+ //Ensure we have an array
101
+ args = rb_check_array_type(args);
102
+
103
+ for (i=0; i<RARRAY(args)->len; i++) {
104
+ pair = rb_ary_entry(args, i);
105
+ pair = rb_check_array_type(pair);
106
+ if(RARRAY(pair)->len != 2)
107
+ rb_raise(rb_eArgError,"Misformed argument in lcall\n");
108
+
109
+ /* Name must be a string. If it is empty string '' then no name*/
110
+ name = rb_ary_entry(pair, 0);
111
+ name = StringValue(name);
112
+ name = rb_funcall(rb_const_get(rb_cObject,
113
+ rb_intern("RSRuby")),
114
+ rb_intern("convert_method_name"),1,name);
115
+
116
+ /* Value can be anything. */
117
+ value = rb_ary_entry(pair, 1);
118
+ rvalue = ruby_to_R(value);
119
+
120
+ /* Add parameter value to call */
121
+ SETCAR(*e, rvalue);
122
+
123
+ /* Add name (if present) */
124
+ if (RSTRING(name)->len > 0)
125
+ {
126
+ SET_TAG(*e, Rf_install(RSTRING(name)->ptr));
127
+ }
128
+
129
+ /* Move index to new end of call */
130
+ *e = CDR(*e);
131
+ }
132
+ return 1;
133
+ }
134
+
135
+ VALUE RObj_to_ruby(VALUE self, VALUE args){
136
+
137
+ int conv;
138
+ VALUE obj;
139
+ SEXP robj;
140
+
141
+ args = rb_check_array_type(args);
142
+
143
+ if (RARRAY(args)->len > 1){
144
+ rb_raise(rb_eArgError,"Too many arguments in to_ruby\n");
145
+ }
146
+
147
+ if (RARRAY(args)->len == 0){
148
+ conv = NUM2INT(rb_cvar_get(rb_const_get(rb_cObject,
149
+ rb_intern("RSRuby")),
150
+ rb_intern("@@default_mode")));
151
+ } else {
152
+ conv = NUM2INT(rb_ary_entry(args,0));
153
+ }
154
+
155
+ if (conv <= -2 || conv > TOP_MODE) {
156
+ rb_raise(rb_eArgError, "Wrong mode\n");
157
+ return Qnil;
158
+ }
159
+
160
+ if (conv < 0)
161
+ conv = TOP_MODE;
162
+
163
+ Data_Get_Struct(self, struct SEXPREC, robj);
164
+
165
+ obj = to_ruby_with_mode(robj, conv);
166
+ return obj;
167
+
168
+ }
169
+
@@ -0,0 +1,183 @@
1
+ /*
2
+ * == Author
3
+ * Alex Gutteridge
4
+ *
5
+ * == Copyright
6
+ *Copyright (C) 2006 Alex Gutteridge
7
+ *
8
+ * The Original Code is the RPy python module.
9
+ *
10
+ * The Initial Developer of the Original Code is Walter Moreira.
11
+ * Portions created by the Initial Developer are Copyright (C) 2002
12
+ * the Initial Developer. All Rights Reserved.
13
+ *
14
+ * Contributor(s):
15
+ * Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
16
+ *
17
+ *This library is free software; you can redistribute it and/or
18
+ *modify it under the terms of the GNU Lesser General Public
19
+ *License as published by the Free Software Foundation; either
20
+ *version 2.1 of the License, or (at your option) any later version.
21
+ *
22
+ *This library is distributed in the hope that it will be useful,
23
+ *but WITHOUT ANY WARRANTY; without even the implied warranty of
24
+ *MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25
+ *Lesser General Public License for more details.
26
+ *
27
+ *You should have received a copy of the GNU Lesser General Public
28
+ *License along with this library; if not, write to the Free Software
29
+ *Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
30
+ */
31
+
32
+ #include "rsruby.h"
33
+
34
+ //TODO - Cleanup and shutdown functions need implementing
35
+ //static PyObject *
36
+ //r_cleanup(void)
37
+ //{
38
+ // r_cleanup();
39
+ // Py_INCREF(Py_None);
40
+ // return Py_None;
41
+ //}
42
+
43
+ /* Global list to protect R objects from garbage collection */
44
+ /* This is inspired in $R_SRC/src/main/memory.c */
45
+ static SEXP R_References;
46
+
47
+ static SEXP
48
+ RecursiveRelease(SEXP obj, SEXP list)
49
+ {
50
+ if (!isNull(list)) {
51
+ if (obj == CAR(list))
52
+ return CDR(list);
53
+ else
54
+ SETCDR(list, RecursiveRelease(obj, CDR(list)));
55
+ }
56
+ return list;
57
+ }
58
+
59
+ /* TODO: This needs implementing as a Ruby destructor for each RObj */
60
+ static void
61
+ Robj_dealloc(VALUE self)
62
+ {
63
+ /* Remove the object from the list of protected objects */
64
+ SEXP robj;
65
+
66
+ Data_Get_Struct(self, struct SEXPREC, robj);
67
+
68
+ R_References = RecursiveRelease(robj, R_References);
69
+ SET_SYMVALUE(install("R.References"), R_References);
70
+
71
+ return;
72
+ }
73
+
74
+ /*
75
+ * Initialises the R interpreter.
76
+ */
77
+ void init_R(int argc, char **argv){
78
+
79
+ int defaultArgc = 2;
80
+ char *defaultArgv[] = {"Rtest","--silent"};
81
+
82
+ if(argc == 0 || argv == NULL) {
83
+ argc = defaultArgc;
84
+ argv = defaultArgv;
85
+ }
86
+ Rf_initEmbeddedR(argc, argv);
87
+ }
88
+
89
+
90
+ /* Obtain an R object via its name.
91
+ * This is only used to get the 'get' function.
92
+ * All subsequent calls go via the 'get' function itself
93
+ */
94
+ VALUE get_fun(VALUE self, VALUE name){
95
+
96
+ VALUE str;
97
+ int conversion=TOP_MODE;
98
+ SEXP robj;
99
+ VALUE rubyobj;
100
+ VALUE params[2];
101
+ char* cstr_name;
102
+
103
+ str = StringValue(name);
104
+
105
+ cstr_name = RSTRING(str)->ptr;
106
+
107
+ robj = (SEXP)get_fun_from_name(cstr_name);
108
+ if (!robj)
109
+ return Qnil;
110
+
111
+ /* Wrap the returned R object as a ruby Object */
112
+ rubyobj = Data_Wrap_Struct(rb_const_get(rb_cObject,
113
+ rb_intern("RObj")), 0, 0, robj);
114
+ rb_iv_set(rubyobj,"@conversion",INT2FIX(conversion));
115
+
116
+ return rubyobj;
117
+
118
+ }
119
+
120
+ //TODO - This function does not appear to be working correctly
121
+ void r_finalize(void)
122
+ {
123
+ unsigned char buf[1024];
124
+ char * tmpdir;
125
+
126
+ R_dot_Last();
127
+ R_RunExitFinalizers();
128
+ CleanEd();
129
+ KillAllDevices();
130
+ if((tmpdir = getenv("R_SESSION_TMPDIR"))) {
131
+ snprintf((char *)buf, 1024, "rm -rf %s", tmpdir);
132
+ R_system((char *)buf);
133
+ }
134
+
135
+ PrintWarnings(); /* from device close and .Last */
136
+ R_gc(); /* Remove any remaining R objects from memory */
137
+ }
138
+
139
+ //TODO - Shutdown is not working correctly
140
+ VALUE cShutdown(VALUE self){
141
+
142
+ r_finalize();
143
+
144
+ self = Qnil;
145
+ return Qtrue;
146
+
147
+ }
148
+
149
+ /*
150
+ * Starts the R interpreter.
151
+ */
152
+ VALUE rr_init(VALUE self){
153
+
154
+ SEXP R_References;
155
+
156
+ init_R(0,NULL);
157
+ // Initialize the list of protected objects
158
+ R_References = R_NilValue;
159
+ SET_SYMVALUE(install("R.References"), R_References);
160
+
161
+ return self;
162
+
163
+ }
164
+
165
+ /* Ruby code */
166
+
167
+ VALUE cRRuby;
168
+ VALUE cRObj;
169
+
170
+ void Init_rsruby(){
171
+
172
+ cRRuby = rb_define_class("RSRuby",rb_cObject);
173
+ cRObj = rb_const_get(rb_cObject,rb_intern("RObj"));
174
+
175
+ rb_define_method(cRRuby, "initialize", rr_init, 0);
176
+ rb_define_method(cRRuby, "get_fun", get_fun, 1);
177
+ rb_define_method(cRRuby, "shutdown", cShutdown, 0);
178
+
179
+ //Add the lcall method to RObj
180
+ rb_define_method(cRObj, "lcall", RObj_lcall, 1);
181
+ rb_define_method(cRObj, "to_ruby", RObj_to_ruby, -2);
182
+
183
+ }