/
lib.rs
161 lines (136 loc) · 4.19 KB
/
lib.rs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
mod error;
mod integer;
mod logical;
mod na;
mod protect;
mod real;
mod sexp;
mod string;
use integer::{IntegerSxp, OwnedIntegerSxp};
use libR_sys::{
cetype_t_CE_UTF8, REprintf, R_NilValue, Rf_allocVector, Rf_mkCharLenCE, Rf_protect,
Rf_unprotect, Rprintf, SET_INTEGER_ELT, SET_LOGICAL_ELT, SET_REAL_ELT, SET_STRING_ELT, SEXP,
};
use logical::{LogicalSxp, OwnedLogicalSxp};
use na::NotAvailableValue;
use protect::{
insert_to_preserved_list, release_from_preserved_list, PreservedList, PRESERVED_LIST,
};
use real::{OwnedRealSxp, RealSxp};
use std::ffi::CString;
use string::{OwnedStringSxp, StringSxp};
// TODO: make this r_println! macro
fn r_print(msg: String) {
unsafe {
let msg_c_string = CString::new(msg).unwrap();
Rprintf(msg_c_string.as_ptr());
}
}
fn r_eprint(msg: String) {
unsafe {
let msg_c_string = CString::new(msg).unwrap();
REprintf(msg_c_string.as_ptr());
}
}
// This wrapper function handles Error and panicks, and flag it by setting the
// lowest bit to 1. The lowest bit is supposed to be detected (and then removed)
// on the corresponding C function.
//
// cf. https://en.wikipedia.org/wiki/Tagged_pointer
pub fn wrapper<F>(f: F) -> SEXP
where
F: FnOnce() -> anyhow::Result<SEXP>,
F: std::panic::UnwindSafe,
{
match std::panic::catch_unwind(f) {
// NOTE: At first, I wrote `(res as usize & !1) as SEXP` to ensure the
// error flag is off, but it's unnecessary because an SEXP should be an
// aligned address, otherwise it should have failed before this point,
// and unaligned address cannot be restored on the C function's side
// anyway.
Ok(Ok(res)) => res,
// Case of an expected error
Ok(Err(e)) => unsafe {
let msg = e.to_string();
let r_error = Rf_mkCharLenCE(
msg.as_ptr() as *const i8,
msg.len() as i32,
cetype_t_CE_UTF8,
);
// set the error flag
(r_error as usize | 1) as SEXP
},
// Case of an unexpected error (i.e., panic)
Err(e) => unsafe {
let msg = format!("{e:?}");
let r_error = Rf_mkCharLenCE(
msg.as_ptr() as *const i8,
msg.len() as i32,
cetype_t_CE_UTF8,
);
// set the error flag
(r_error as usize | 1) as SEXP
},
}
}
unsafe fn to_upper_inner(x: SEXP) -> anyhow::Result<SEXP> {
let x = StringSxp::try_from(x)?;
let mut out = OwnedStringSxp::new(x.len());
for (i, e) in x.iter().enumerate() {
if e.is_na() {
out.set_elt(i, <&str>::na());
continue;
}
let e_upper = e.to_uppercase();
out.set_elt(i, e_upper.as_str());
}
Ok(out.inner())
}
#[no_mangle]
pub unsafe extern "C" fn unextendr_to_upper(x: SEXP) -> SEXP {
wrapper(|| to_upper_inner(x))
}
unsafe fn times_two_int_inner(x: SEXP) -> anyhow::Result<SEXP> {
let x = IntegerSxp::try_from(x)?;
let mut out = OwnedIntegerSxp::new(x.len());
for (i, e) in x.iter().enumerate() {
if e.is_na() {
out.set_elt(i, i32::na());
} else {
out.set_elt(i, e * 2);
}
}
Ok(out.inner())
}
#[no_mangle]
pub unsafe extern "C" fn unextendr_times_two_int(x: SEXP) -> SEXP {
wrapper(|| times_two_int_inner(x))
}
unsafe fn times_two_numeric_inner(x: SEXP) -> anyhow::Result<SEXP> {
let x = RealSxp::try_from(x)?;
let mut out = OwnedRealSxp::new(x.len());
for (i, e) in x.iter().enumerate() {
if e.is_na() {
out.set_elt(i, f64::na())
} else {
out.set_elt(i, e * 2.0)
}
}
Ok(out.inner())
}
#[no_mangle]
pub unsafe extern "C" fn unextendr_times_two_numeric(x: SEXP) -> SEXP {
wrapper(|| times_two_numeric_inner(x))
}
unsafe fn flip_logical_inner(x: SEXP) -> anyhow::Result<SEXP> {
let x = LogicalSxp::try_from(x)?;
let mut out = OwnedLogicalSxp::new(x.len());
for (i, e) in x.iter().enumerate() {
out.set_elt(i, !e);
}
Ok(out.inner())
}
#[no_mangle]
pub unsafe extern "C" fn unextendr_flip_logical(x: SEXP) -> SEXP {
wrapper(|| flip_logical_inner(x))
}