Skip to main content

aorist_extendr_api/robj/
rinternals.rs

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