extendr_api/robj/
rinternals.rs

1use crate::*;
2use extendr_ffi::{
3    get_var_safe, is_data_frame, R_CFinalizer_t, R_ExternalPtrAddr, R_ExternalPtrProtected,
4    R_ExternalPtrTag, R_GetCurrentSrcref, R_GetSrcFilename, R_IsNamespaceEnv, R_IsPackageEnv,
5    R_MakeExternalPtr, R_MissingArg, R_NamespaceEnvSpec, R_PackageEnvName, R_RegisterCFinalizerEx,
6    R_xlen_t, Rboolean, Rf_PairToVectorList, Rf_VectorToPairList, Rf_allocMatrix, Rf_allocVector,
7    Rf_asChar, Rf_asCharacterFactor, Rf_coerceVector, Rf_conformable, Rf_duplicate, Rf_findFun,
8    Rf_isArray, Rf_isComplex, Rf_isEnvironment, Rf_isExpression, Rf_isFactor, Rf_isFunction,
9    Rf_isInteger, Rf_isLanguage, Rf_isList, Rf_isLogical, Rf_isMatrix, Rf_isNewList, Rf_isNull,
10    Rf_isNumber, Rf_isObject, Rf_isPrimitive, Rf_isReal, Rf_isS4, Rf_isString, Rf_isSymbol,
11    Rf_isTs, Rf_isUserBinop, Rf_isVector, Rf_isVectorAtomic, Rf_isVectorList, Rf_isVectorizable,
12    Rf_ncols, Rf_nrows, Rf_xlengthgets, ALTREP, TYPEOF,
13};
14///////////////////////////////////////////////////////////////
15/// The following impls wrap specific Rinternals.h functions.
16///
17pub trait Rinternals: Types + Conversions {
18    /// Return true if this is the null object.
19    fn is_null(&self) -> bool {
20        unsafe { Rf_isNull(self.get()).into() }
21    }
22
23    /// Return true if this is a symbol.
24    fn is_symbol(&self) -> bool {
25        unsafe { Rf_isSymbol(self.get()).into() }
26    }
27
28    /// Return true if this is a boolean (logical) vector
29    fn is_logical(&self) -> bool {
30        unsafe { Rf_isLogical(self.get()).into() }
31    }
32
33    /// Return true if this is a real (f64) vector.
34    fn is_real(&self) -> bool {
35        unsafe { Rf_isReal(self.get()).into() }
36    }
37
38    /// Return true if this is a complex vector.
39    fn is_complex(&self) -> bool {
40        unsafe { Rf_isComplex(self.get()).into() }
41    }
42
43    /// Return true if this is an expression.
44    fn is_expressions(&self) -> bool {
45        unsafe { Rf_isExpression(self.get()).into() }
46    }
47
48    /// Return true if this is an environment.
49    fn is_environment(&self) -> bool {
50        unsafe { Rf_isEnvironment(self.get()).into() }
51    }
52
53    /// Return true if this is an environment.
54    fn is_promise(&self) -> bool {
55        self.sexptype() == SEXPTYPE::PROMSXP
56    }
57
58    /// Return true if this is a string.
59    fn is_string(&self) -> bool {
60        unsafe { Rf_isString(self.get()).into() }
61    }
62
63    /// Return true if this is an object (ie. has a class attribute).
64    fn is_object(&self) -> bool {
65        unsafe { Rf_isObject(self.get()).into() }
66    }
67
68    /// Return true if this is a S4 object.
69    fn is_s4(&self) -> bool {
70        unsafe { Rf_isS4(self.get()).into() }
71    }
72
73    /// Return true if this is an expression.
74    fn is_external_pointer(&self) -> bool {
75        self.rtype() == Rtype::ExternalPtr
76    }
77
78    /// Get the source ref.
79    fn get_current_srcref(val: i32) -> Robj {
80        unsafe { Robj::from_sexp(R_GetCurrentSrcref(val as std::ffi::c_int)) }
81    }
82
83    /// Get the source filename.
84    fn get_src_filename(&self) -> Robj {
85        unsafe { Robj::from_sexp(R_GetSrcFilename(self.get())) }
86    }
87
88    /// Convert to a string vector.
89    fn as_character_vector(&self) -> Robj {
90        unsafe { Robj::from_sexp(Rf_asChar(self.get())) }
91    }
92
93    /// Convert to vectors of many kinds.
94    fn coerce_vector(&self, sexptype: SEXPTYPE) -> Robj {
95        single_threaded(|| unsafe { Robj::from_sexp(Rf_coerceVector(self.get(), sexptype)) })
96    }
97
98    /// Convert a pairlist (LISTSXP) to a vector list (VECSXP).
99    fn pair_to_vector_list(&self) -> Robj {
100        single_threaded(|| unsafe { Robj::from_sexp(Rf_PairToVectorList(self.get())) })
101    }
102
103    /// Convert a vector list (VECSXP) to a pair list (LISTSXP)
104    fn vector_to_pair_list(&self) -> Robj {
105        single_threaded(|| unsafe { Robj::from_sexp(Rf_VectorToPairList(self.get())) })
106    }
107
108    /// Convert a factor to a string vector.
109    fn as_character_factor(&self) -> Robj {
110        single_threaded(|| unsafe { Robj::from_sexp(Rf_asCharacterFactor(self.get())) })
111    }
112
113    /// Allocate a matrix object.
114    fn alloc_matrix(sexptype: SEXPTYPE, rows: i32, cols: i32) -> Robj {
115        single_threaded(|| unsafe { Robj::from_sexp(Rf_allocMatrix(sexptype, rows, cols)) })
116    }
117
118    /// Do a deep copy of this object.
119    /// Note that clone() only adds a reference.
120    fn duplicate(&self) -> Robj {
121        single_threaded(|| unsafe { Robj::from_sexp(Rf_duplicate(self.get())) })
122    }
123
124    /// Find a function in an environment ignoring other variables.
125    ///
126    /// This evaulates promises if they are found.
127    ///
128    /// See also [global_function()].
129    /// ```
130    /// use extendr_api::prelude::*;
131    /// test! {
132    ///    let my_fun = base_env().find_function(sym!(ls)).unwrap();
133    ///    assert_eq!(my_fun.is_function(), true);
134    ///
135    ///    // Note: this may crash on some versions of windows which don't support unwinding.
136    ///    // assert!(base_env().find_function(sym!(qwertyuiop)).is_none());
137    /// }
138    /// ```
139    fn find_function<K: TryInto<Symbol, Error = Error>>(&self, key: K) -> Result<Robj> {
140        let key: Symbol = key.try_into()?;
141        if !self.is_environment() {
142            return Err(Error::NotFound(key.into()));
143        }
144        // This may be better:
145        // let mut env: Robj = self.into();
146        // loop {
147        //     if let Some(var) = env.local(&key) {
148        //         if let Some(var) = var.eval_promise() {
149        //             if var.is_function() {
150        //                 break Some(var);
151        //             }
152        //         }
153        //     }
154        //     if let Some(parent) = env.parent() {
155        //         env = parent;
156        //     } else {
157        //         break None;
158        //     }
159        // }
160        unsafe {
161            let sexp = self.get();
162            if let Ok(var) = catch_r_error(|| Rf_findFun(key.get(), sexp)) {
163                Ok(Robj::from_sexp(var))
164            } else {
165                Err(Error::NotFound(key.into()))
166            }
167        }
168    }
169
170    /// Find a variable in an environment.
171    ///
172    // //TODO: fix me, as this variable is hidden behind non-api as of this writing
173    // See also [global_var()].
174    ///
175    /// Note that many common variables and functions are contained in promises
176    /// which must be evaluated and this function may throw an R error.
177    ///
178    fn find_var<K: TryInto<Symbol, Error = Error>>(&self, key: K) -> Result<Robj> {
179        let key: Symbol = key.try_into()?;
180        if !self.is_environment() {
181            return Err(Error::NotFound(key.into()));
182        }
183        // Alternative:
184        // let mut env: Robj = self.into();
185        // loop {
186        //     if let Some(var) = env.local(&key) {
187        //         println!("v1={:?}", var);
188        //         if let Some(var) = var.eval_promise() {
189        //             println!("v2={:?}", var);
190        //             break Some(var);
191        //         }
192        //     }
193        //     if let Some(parent) = env.parent() {
194        //         env = parent;
195        //     } else {
196        //         break None;
197        //     }
198        // }
199        unsafe {
200            let sexp = self.get();
201            match get_var_safe(key.get(), sexp) {
202                Some(var) => Ok(Robj::from_sexp(var)),
203                None => Err(Error::NotFound(key.into())),
204            }
205        }
206    }
207
208    #[cfg(feature = "non-api")]
209    /// If this object is a promise, evaluate it, otherwise return the object.
210    /// ```
211    /// use extendr_api::prelude::*;
212    /// test! {
213    ///    let iris_promise = global_env().find_var(sym!(iris)).unwrap();
214    ///    let iris_dataframe = iris_promise.eval_promise().unwrap();
215    ///    assert_eq!(iris_dataframe.is_frame(), true);
216    /// }
217    /// ```
218    fn eval_promise(&self) -> Result<Robj> {
219        if self.is_promise() {
220            self.as_promise().unwrap().eval()
221        } else {
222            Ok(self.as_robj().clone())
223        }
224    }
225
226    /// Number of columns of a matrix
227    fn ncols(&self) -> usize {
228        unsafe { Rf_ncols(self.get()) as usize }
229    }
230
231    /// Number of rows of a matrix
232    fn nrows(&self) -> usize {
233        unsafe { Rf_nrows(self.get()) as usize }
234    }
235
236    /// Internal function used to implement `#[extendr]` impl
237    #[doc(hidden)]
238    unsafe fn make_external_ptr<T>(p: *mut T, prot: Robj) -> Robj {
239        let type_name: Robj = std::any::type_name::<T>().into();
240        Robj::from_sexp(single_threaded(|| {
241            R_MakeExternalPtr(
242                p as *mut ::std::os::raw::c_void,
243                type_name.get(),
244                prot.get(),
245            )
246        }))
247    }
248
249    /// Internal function used to implement `#[extendr]` impl
250    #[doc(hidden)]
251    unsafe fn external_ptr_addr<T>(&self) -> *mut T {
252        R_ExternalPtrAddr(self.get()).cast()
253    }
254
255    /// Internal function used to implement `#[extendr]` impl
256    #[doc(hidden)]
257    unsafe fn external_ptr_tag(&self) -> Robj {
258        Robj::from_sexp(R_ExternalPtrTag(self.get()))
259    }
260
261    /// Internal function used to implement `#[extendr]` impl
262    #[doc(hidden)]
263    unsafe fn external_ptr_protected(&self) -> Robj {
264        Robj::from_sexp(R_ExternalPtrProtected(self.get()))
265    }
266
267    #[doc(hidden)]
268    unsafe fn register_c_finalizer(&self, func: R_CFinalizer_t) {
269        // Use R_RegisterCFinalizerEx() and set onexit to 1 (TRUE) to invoke the
270        // finalizer on a shutdown of the R session as well.
271        single_threaded(|| R_RegisterCFinalizerEx(self.get(), func, Rboolean::TRUE));
272    }
273
274    /// Copy a vector and resize it.
275    /// See. <https://github.com/hadley/r-internals/blob/master/vectors.md>
276    fn xlengthgets(&self, new_len: usize) -> Result<Robj> {
277        unsafe {
278            if self.is_vector() {
279                Ok(single_threaded(|| {
280                    Robj::from_sexp(Rf_xlengthgets(self.get(), new_len as R_xlen_t))
281                }))
282            } else {
283                Err(Error::ExpectedVector(self.as_robj().clone()))
284            }
285        }
286    }
287
288    /// Allocated an owned object of a certain type.
289    fn alloc_vector(sexptype: SEXPTYPE, len: usize) -> Robj {
290        single_threaded(|| unsafe { Robj::from_sexp(Rf_allocVector(sexptype, len as R_xlen_t)) })
291    }
292
293    /// Return true if two arrays have identical dims.
294    fn conformable(a: &Robj, b: &Robj) -> bool {
295        single_threaded(|| unsafe { Rf_conformable(a.get(), b.get()).into() })
296    }
297
298    /// Return true if this is an array.
299    fn is_array(&self) -> bool {
300        unsafe { Rf_isArray(self.get()).into() }
301    }
302
303    /// Return true if this is factor.
304    fn is_factor(&self) -> bool {
305        unsafe { Rf_isFactor(self.get()).into() }
306    }
307
308    /// Return true if this is a data frame.
309    fn is_frame(&self) -> bool {
310        unsafe { is_data_frame(self.get()).into() }
311    }
312
313    /// Return true if this is a function or a primitive (CLOSXP, BUILTINSXP or SPECIALSXP)
314    fn is_function(&self) -> bool {
315        unsafe { Rf_isFunction(self.get()).into() }
316    }
317
318    /// Return true if this is an integer vector (INTSXP) but not a factor.
319    fn is_integer(&self) -> bool {
320        unsafe { Rf_isInteger(self.get()).into() }
321    }
322
323    /// Return true if this is a language object (LANGSXP).
324    fn is_language(&self) -> bool {
325        unsafe { Rf_isLanguage(self.get()).into() }
326    }
327
328    /// Return true if this is NILSXP or LISTSXP.
329    fn is_pairlist(&self) -> bool {
330        unsafe { Rf_isList(self.get()).into() }
331    }
332
333    /// Return true if this is a matrix.
334    fn is_matrix(&self) -> bool {
335        unsafe { Rf_isMatrix(self.get()).into() }
336    }
337
338    /// Return true if this is NILSXP or VECSXP.
339    fn is_list(&self) -> bool {
340        unsafe { Rf_isNewList(self.get()).into() }
341    }
342
343    /// Return true if this is INTSXP, LGLSXP or REALSXP but not a factor.
344    fn is_number(&self) -> bool {
345        unsafe { Rf_isNumber(self.get()).into() }
346    }
347
348    /// Return true if this is a primitive function BUILTINSXP, SPECIALSXP.
349    fn is_primitive(&self) -> bool {
350        unsafe { Rf_isPrimitive(self.get()).into() }
351    }
352
353    /// Return true if this is a time series vector (see tsp).
354    fn is_ts(&self) -> bool {
355        unsafe { Rf_isTs(self.get()).into() }
356    }
357
358    /// Return true if this is a user defined binop.
359    fn is_user_binop(&self) -> bool {
360        unsafe { Rf_isUserBinop(self.get()).into() }
361    }
362
363    #[cfg(feature = "non-api")]
364    /// Return true if this is a valid string.
365    fn is_valid_string(&self) -> bool {
366        unsafe { extendr_ffi::Rf_isValidString(self.get()).into() }
367    }
368
369    #[cfg(feature = "non-api")]
370    /// Return true if this is a valid string.
371    fn is_valid_string_f(&self) -> bool {
372        unsafe { extendr_ffi::Rf_isValidStringF(self.get()).into() }
373    }
374
375    /// Return true if this is a vector.
376    fn is_vector(&self) -> bool {
377        unsafe { Rf_isVector(self.get()).into() }
378    }
379
380    /// Return true if this is an atomic vector.
381    fn is_vector_atomic(&self) -> bool {
382        unsafe { Rf_isVectorAtomic(self.get()).into() }
383    }
384
385    /// Return true if this is a vector list.
386    fn is_vector_list(&self) -> bool {
387        unsafe { Rf_isVectorList(self.get()).into() }
388    }
389
390    /// Return true if this is can be made into a vector.
391    fn is_vectorizable(&self) -> bool {
392        unsafe { Rf_isVectorizable(self.get()).into() }
393    }
394
395    /// Return true if this is RAWSXP.
396    fn is_raw(&self) -> bool {
397        self.rtype() == Rtype::Raw
398    }
399
400    /// Return true if this is CHARSXP.
401    fn is_char(&self) -> bool {
402        self.rtype() == Rtype::Rstr
403    }
404
405    /// Check an external pointer tag.
406    /// This is used to wrap R objects.
407    #[doc(hidden)]
408    fn check_external_ptr_type<T>(&self) -> bool {
409        if self.sexptype() == SEXPTYPE::EXTPTRSXP {
410            let tag = unsafe { self.external_ptr_tag() };
411            if tag.as_str() == Some(std::any::type_name::<T>()) {
412                return true;
413            }
414        }
415        false
416    }
417
418    fn is_missing_arg(&self) -> bool {
419        unsafe { self.get() == R_MissingArg }
420    }
421
422    #[cfg(not(r_4_5))]
423    fn is_unbound_value(&self) -> bool {
424        unsafe { self.get() == extendr_ffi::R_UnboundValue }
425    }
426
427    fn is_package_env(&self) -> bool {
428        unsafe { R_IsPackageEnv(self.get()).into() }
429    }
430
431    fn package_env_name(&self) -> Robj {
432        unsafe { Robj::from_sexp(R_PackageEnvName(self.get())) }
433    }
434
435    fn is_namespace_env(&self) -> bool {
436        unsafe { R_IsNamespaceEnv(self.get()).into() }
437    }
438
439    fn namespace_env_spec(&self) -> Robj {
440        unsafe { Robj::from_sexp(R_NamespaceEnvSpec(self.get())) }
441    }
442
443    /// Returns `true` if this is an ALTREP object.
444    fn is_altrep(&self) -> bool {
445        unsafe { ALTREP(self.get()) != 0 }
446    }
447
448    /// Returns `true` if this is an integer ALTREP object.
449    fn is_altinteger(&self) -> bool {
450        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::INTSXP }
451    }
452
453    /// Returns `true` if this is an real ALTREP object.
454    fn is_altreal(&self) -> bool {
455        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::REALSXP }
456    }
457
458    /// Returns `true` if this is an logical ALTREP object.
459    fn is_altlogical(&self) -> bool {
460        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::LGLSXP }
461    }
462
463    /// Returns `true` if this is a raw ALTREP object.
464    fn is_altraw(&self) -> bool {
465        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::RAWSXP }
466    }
467
468    /// Returns `true` if this is an integer ALTREP object.
469    fn is_altstring(&self) -> bool {
470        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::STRSXP }
471    }
472
473    /// Returns `true` if this is an integer ALTREP object.
474    #[cfg(use_r_altlist)]
475    fn is_altlist(&self) -> bool {
476        unsafe { ALTREP(self.get()) != 0 && TYPEOF(self.get()) == SEXPTYPE::VECSXP }
477    }
478
479    /// Generate a text representation of this object.
480    fn deparse(&self) -> Result<String> {
481        use crate as extendr_api;
482        let strings: Strings = call!("deparse", self.as_robj())?.try_into()?;
483        if strings.len() == 1 {
484            Ok(String::from(strings.elt(0).as_ref()))
485        } else {
486            Ok(strings
487                .iter()
488                .map(|s| s.as_ref())
489                .collect::<Vec<_>>()
490                .join(""))
491        }
492    }
493}
494
495impl Rinternals for Robj {}
extendr_api/robj/rinternals.rs

extendr_api/robj/
rinternals.rs
