Skip to content

Commit 739de87

Browse files
lionel-lionel-
committed
Don't use illegal attributes accessors
1 parent 809d9a5 commit 739de87

File tree

5 files changed

+96
-36
lines changed

5 files changed

+96
-36
lines changed

‎crates/ark/src/srcref.rs‎

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -179,10 +179,10 @@ fn generate_source(
179179
SET_VECTOR_ELT(consts, 0, R_ClosureExpr(new));
180180
}
181181

182-
Rf_setAttrib(
182+
harp::attrib_poke(
183183
old.sexp,
184184
r_symbol!("srcref"),
185-
Rf_getAttrib(new, r_symbol!("srcref")),
185+
harp::attrib_get(new, r_symbol!("srcref")),
186186
);
187187
} else {
188188
let new_body = harp::fn_body(new);
@@ -192,17 +192,11 @@ fn generate_source(
192192
harp::fn_env(old.sexp),
193193
));
194194

195-
// TODO: Avoid `ATTRIB()`
196-
let attrib = ATTRIB(old.sexp);
197-
if attrib != R_NilValue {
198-
let attrib = RObject::new(Rf_shallow_duplicate(attrib));
199-
SET_ATTRIB(out.sexp, attrib.sexp);
200-
}
201-
202-
Rf_setAttrib(
195+
harp::attrib_poke_from(out.sexp, old.sexp);
196+
harp::attrib_poke(
203197
out.sexp,
204198
r_symbol!("srcref"),
205-
Rf_getAttrib(new, r_symbol!("srcref")),
199+
harp::attrib_get(new, r_symbol!("srcref")),
206200
);
207201

208202
harp::env_bind_force(ns_env, binding.name.sexp, out.sexp);

‎crates/harp/src/attrib.rs‎

Lines changed: 4 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
use libr::SEXP;
22

33
use crate::object::r_length;
4+
use crate::r::attrib_poke;
5+
use crate::r::attrib_poke_from;
46
use crate::r::fn_body;
57
use crate::r::fn_env;
68
use crate::r::fn_formals;
@@ -30,16 +32,8 @@ fn zap_srcref_fn(x: SEXP) -> RObject {
3032
let out = RObject::new(new_function(formals, new_body.sexp, env));
3133

3234
// Copy attributes from the original, but zap `srcref`
33-
let attrib = libr::ATTRIB(x);
34-
if attrib != r_null() {
35-
if libr::Rf_getAttrib(x, r_symbol!("srcref")) == r_null() {
36-
libr::SET_ATTRIB(out.sexp, attrib);
37-
} else {
38-
let attrib = RObject::new(libr::Rf_duplicate(attrib));
39-
libr::SET_ATTRIB(out.sexp, attrib.sexp);
40-
libr::Rf_setAttrib(out.sexp, r_symbol!("srcref"), r_null());
41-
}
42-
}
35+
attrib_poke_from(out.sexp, x);
36+
attrib_poke(out.sexp, r_symbol!("srcref"), r_null());
4337

4438
out
4539
}

‎crates/harp/src/r.rs‎

Lines changed: 71 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
use libr::SEXP;
22

3+
// --- Closure accessors ---
4+
35
pub fn fn_formals(x: SEXP) -> SEXP {
46
unsafe { libr::FORMALS(x) }
57
}
@@ -24,6 +26,16 @@ pub fn fn_env(x: SEXP) -> SEXP {
2426
}
2527
}
2628

29+
pub unsafe fn new_function(formals: SEXP, body: SEXP, env: SEXP) -> SEXP {
30+
if libr::has::R_mkClosure() {
31+
libr::R_mkClosure(formals, body, env)
32+
} else {
33+
compat::alloc_closure(formals, body, env)
34+
}
35+
}
36+
37+
// --- Environment bindings ---
38+
2739
pub fn env_binding_is_locked(env: SEXP, sym: SEXP) -> bool {
2840
unsafe { libr::R_BindingIsLocked(sym, env) != 0 }
2941
}
@@ -54,15 +66,60 @@ pub fn env_bind_force(env: SEXP, sym: SEXP, value: SEXP) {
5466
}
5567
}
5668

57-
/// Creates a closure.
58-
pub unsafe fn new_function(formals: SEXP, body: SEXP, env: SEXP) -> SEXP {
59-
if libr::has::R_mkClosure() {
60-
libr::R_mkClosure(formals, body, env)
61-
} else {
62-
compat::alloc_closure(formals, body, env)
69+
// --- Attributes ---
70+
71+
/// Gets an attribute from `x`.
72+
pub fn attrib_get(x: SEXP, tag: SEXP) -> SEXP {
73+
unsafe { libr::Rf_getAttrib(x, tag) }
74+
}
75+
76+
pub fn attrib_poke(x: SEXP, tag: SEXP, value: SEXP) {
77+
unsafe {
78+
libr::Rf_setAttrib(x, tag, value);
6379
}
6480
}
6581

82+
/// Returns `true` if `x` has any attributes.
83+
pub fn attrib_has_any(x: SEXP) -> bool {
84+
unsafe {
85+
if libr::has::ANY_ATTRIB() {
86+
libr::ANY_ATTRIB(x) != 0
87+
} else {
88+
libr::ATTRIB(x) != libr::R_NilValue
89+
}
90+
}
91+
}
92+
93+
/// Iterates over the attributes of `x`, calling `f(tag, value)` for each.
94+
pub fn attrib_for_each<F: FnMut(SEXP, SEXP)>(x: SEXP, mut f: F) {
95+
unsafe {
96+
if libr::has::R_mapAttrib() {
97+
unsafe extern "C-unwind" fn trampoline<F: FnMut(SEXP, SEXP)>(
98+
tag: SEXP,
99+
val: SEXP,
100+
data: *mut std::ffi::c_void,
101+
) -> SEXP {
102+
let f = &mut *(data as *mut F);
103+
f(tag, val);
104+
std::ptr::null_mut()
105+
}
106+
let data = &mut f as *mut F as *mut std::ffi::c_void;
107+
libr::R_mapAttrib(x, Some(trampoline::<F>), data);
108+
} else {
109+
compat::map_attrib(x, &mut f);
110+
}
111+
}
112+
}
113+
114+
/// Copies all attributes from `src` to `dst`.
115+
pub fn attrib_poke_from(dst: SEXP, src: SEXP) {
116+
attrib_for_each(src, |tag, val| unsafe {
117+
libr::Rf_setAttrib(dst, tag, val);
118+
});
119+
}
120+
121+
// --- Compat polyfills for older R ---
122+
66123
mod compat {
67124
use libr::SEXP;
68125

@@ -73,4 +130,12 @@ mod compat {
73130
libr::SET_CLOENV(out, env);
74131
out
75132
}
133+
134+
pub unsafe fn map_attrib<F: FnMut(SEXP, SEXP)>(x: SEXP, f: &mut F) {
135+
let mut node = libr::ATTRIB(x);
136+
while node != libr::R_NilValue {
137+
f(libr::TAG(node), libr::CAR(node));
138+
node = libr::CDR(node);
139+
}
140+
}
76141
}

‎crates/harp/src/size.rs‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,8 @@ use crate::environment::R_ENVS;
2020
use crate::list_get;
2121
use crate::object::r_chr_get;
2222
use crate::object::r_length;
23+
use crate::r::attrib_for_each;
24+
use crate::r::attrib_has_any;
2325
use crate::r::fn_body;
2426
use crate::r::fn_env;
2527
use crate::r::fn_formals;
@@ -117,15 +119,12 @@ fn obj_size_tree(
117119
return size;
118120
}
119121

120-
if r_typeof(x) != CHARSXP {
121-
size += obj_size_tree(
122-
unsafe { libr::ATTRIB(x) },
123-
base_env,
124-
sizeof_node,
125-
sizeof_vector,
126-
seen,
127-
depth + 1,
128-
);
122+
if r_typeof(x) != CHARSXP && attrib_has_any(x) {
123+
attrib_for_each(x, |tag, val| {
124+
size += sizeof_node;
125+
size += obj_size_tree(tag, base_env, sizeof_node, sizeof_vector, seen, depth + 1);
126+
size += obj_size_tree(val, base_env, sizeof_node, sizeof_vector, seen, depth + 1);
127+
});
129128
}
130129

131130
match r_typeof(x) {

‎crates/libr/src/r.rs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -228,6 +228,14 @@ functions::generate! {
228228

229229
pub fn SET_ATTRIB(x: SEXP, v: SEXP);
230230

231+
pub fn ANY_ATTRIB(x: SEXP) -> std::ffi::c_int;
232+
233+
pub fn R_mapAttrib(
234+
x: SEXP,
235+
fun: Option<unsafe extern "C-unwind" fn(tag: SEXP, val: SEXP, data: *mut std::ffi::c_void) -> SEXP>,
236+
data: *mut std::ffi::c_void,
237+
) -> SEXP;
238+
231239
pub fn CADDDR(e: SEXP) -> SEXP;
232240

233241
pub fn CADDR(e: SEXP) -> SEXP;

0 commit comments

Comments
 (0)