rustr/
environment.rs

1//! R Enviroment type
2//!
3//!
4
5
6use ::rdll::*;
7use ::storage::*;
8use ::traits::*;
9use ::rtype::*;
10use ::error::*;
11use std::convert::*;
12
13use ::util::*;
14
15use eval::*;
16use ::symbol::*;
17use ::protect::stackp::*;
18
19pub type Envir = EnvirM<Preserve>;
20pub type EnvirN = EnvirM<NoProtect>;
21
22use std::str::FromStr;
23
24gen_traits_sexp!(EnvirM);
25
26impl<T: SEXPbucket> FromStr for EnvirM<T> {
27    type Err = RError;
28    fn from_str(name: &str) -> RResult<EnvirM<T>> {
29        unsafe {
30
31            // similar to matchEnvir@envir.c
32            if name == ".GlobalEnv" {
33                Ok(EnvirM { data: T::new(R_GlobalEnv) })
34            } else if name == "package:base" {
35                Ok(EnvirM { data: T::new(R_BaseEnv) })
36            } else {
37                let as_environment_sym = Rf_install(c_str("as.environment").as_ptr());
38                let res = rustr_eval(Rf_lang2(as_environment_sym,
39                                              Rf_mkString(c_str(name).as_ptr())),
40                                     R_GlobalEnv);
41                match res {
42                    Ok(aa) => Ok(EnvirM { data: T::new(aa) }),
43                    Err(_) => rraise("fail to create enviroment"), 
44                }
45            }
46        }
47    }
48}
49
50impl<T: SEXPbucket> EnvirM<T> {
51    pub fn from_sexp<TT: ToSEXP>(s: TT) -> RResult<EnvirM<T>> {
52        unsafe {
53            if RTYPEOF(s.s()) == ENVSXP {
54                return Ok(EnvirM { data: T::new(s.s()) });
55            }
56            Ok(EnvirM {
57                data: T::new(rustr_eval(Rf_lang2(Rf_install(c_str("as.environment")
58                                                                     .as_ptr()),
59                                                      s.s()),
60                                             R_GlobalEnv)?),
61            })
62        }
63    }
64    pub unsafe fn from_sexp_envir(x: SEXP) -> EnvirM<T> {
65        EnvirM { data: T::new(x) }
66    }
67    pub fn set<E: ToSEXP>(&mut self, x: E) -> RResult<()> {
68        match EnvirM::<T>::from_sexp(unsafe { x.s() }) {
69            Ok(res) => {
70                self.data.set(unsafe { res.s() });
71                Ok(())
72            }
73            Err(e) => rraise(e),
74        }
75    }
76
77    pub fn new<E: ToSEXP>(x: E) -> RResult<EnvirM<T>> {
78        match EnvirM::<T>::from_sexp(unsafe { x.s() }) {
79            Ok(res) => Ok(EnvirM { data: unsafe { T::new(res.s()) } }),
80            Err(e) => rraise(e),
81        }
82    }
83
84    pub fn from_pos(pos: ::std::os::raw::c_int) -> RResult<EnvirM<T>> {
85        unsafe {
86            let as_environment_sym = Rf_install(c_str("as.environment").as_ptr());
87            let res = rustr_eval(Rf_lang2(as_environment_sym, Rf_ScalarInteger(pos)),
88                                 R_GlobalEnv);
89            match res {
90                Ok(aa) => Ok(EnvirM { data: T::new(aa) }),
91                Err(e) => rraise(e), 
92            }
93        }
94    }
95    /** 
96         * Indicates if this is a user defined database.
97         */
98    fn is_user_database(&self) -> bool {
99        unsafe {
100            OBJECT(self.data.s()) == 1 &&
101            Rf_inherits(self.data.s(), c_str("UserDefinedDatabase").as_ptr()) == Rboolean::TRUE
102        }
103    }
104    pub fn global() -> EnvirM<NoProtect> {
105        unsafe { EnvirM { data: NoProtect::new(R_GlobalEnv) } }
106    }
107
108    pub fn empty() -> EnvirM<T> {
109        unsafe { EnvirM { data: T::new(R_EmptyEnv) } }
110    }
111
112    pub fn base() -> EnvirM<T> {
113        unsafe { EnvirM { data: T::new(R_BaseEnv) } }
114    }
115
116    pub fn base_namespace() -> EnvirM<T> {
117        unsafe { EnvirM { data: T::new(R_BaseNamespace) } }
118    }
119    pub fn namespace_env(package: &str) -> RResult<EnvirM<T>> {
120        unsafe {
121            let get_namespace_sym = Rf_install(c_str("getNamespace").as_ptr());
122            let env = rustr_eval(Rf_lang2(get_namespace_sym, Rf_mkString(c_str(package).as_ptr())),
123                                 R_GlobalEnv);
124            match env {
125                Ok(aa) => Ok(EnvirM { data: T::new(aa) }),
126                Err(e) => rraise(e), 
127            }
128        }
129
130    }
131    pub fn parent(&self) -> EnvirM<T> {
132        unsafe { EnvirM { data: T::new(ENCLOS(self.data.s())) } }
133    }
134
135    /**
136         * creates a new environment whose this is the parent
137         */
138    pub fn new_child(&self, hashed: ::std::os::raw::c_int) -> RResult<EnvirM<T>> {
139        unsafe {
140            let new_env_sym = cstr_sym("new.env");
141            let sexp = rustr_eval(Rf_lang3(new_env_sym,
142                                                Rf_ScalarLogical(hashed),
143                                                self.data.s()),
144                                       R_GlobalEnv)?;
145
146            Ok(EnvirM { data: T::new(sexp) })
147        }
148    }
149    pub fn ls<D: RNew>(&self, all: Rboolean) -> RResult<D> {
150
151        unsafe {
152            if self.is_user_database() {
153                let tb: *mut R_ObjectTable =
154                    ::std::mem::transmute(R_ExternalPtrAddr(HASHTAB(self.data.s())));
155                match (*tb).objects {
156                    Some(resfn) => D::rnew(resfn(tb)),
157                    None => rraise("ls() R_ExternalPtrAddr is invalid."),
158                }
159            } else {
160
161                D::rnew(R_lsInternal(self.data.s(), all))
162            }
163        }
164    }
165    pub fn get<D: RNew>(&self, name: &str) -> RResult<D> {
166        unsafe {
167            let res = Rf_findVarInFrame(self.data.s(), Symbol::from(name).s());
168
169            if res == R_UnboundValue {
170                return D::rnew(R_NilValue);
171            }
172
173            // We need to evaluate if it is a promise
174            if RTYPEOF(res) == PROMSXP {
175                let res2 = Rf_eval(res, self.data.s());
176                return D::rnew(res2);
177            }
178            D::rnew(res)
179        }
180    }
181    pub fn find<D: RNew>(&self, name: &str) -> RResult<D> {
182        unsafe {
183            let res = Rf_findVar(Symbol::from(name).s(), self.data.s());
184
185            if res == R_UnboundValue {
186                return rraise(format!("binding not found: {:?}", name));
187            }
188            // We need to evaluate if it is a promise
189            if RTYPEOF(res) == PROMSXP {
190                let res2 = Rf_eval(res, self.data.s());
191                return D::rnew(res2);
192            }
193
194            D::rnew(res)
195        }
196
197    }
198
199    pub fn exists(&self, name: &str) -> bool {
200        unsafe {
201            let res = Rf_findVarInFrame(self.data.s(), Symbol::from(name).s());
202            res != R_UnboundValue
203        }
204    }
205    #[allow(non_snake_case)]
206    pub fn bindingIsLocked(&self, name: &str) -> RResult<bool> {
207        if !self.exists(name) {
208            return rraise(format!("no such binding: {:?}", name));
209        }
210        unsafe { Ok(R_BindingIsLocked(Symbol::from(name).s(), self.data.s()) == Rboolean::TRUE) }
211
212    }
213
214    pub fn assign<E: ToSEXP>(&self, name: &str, x: E) -> RResult<()> {
215
216        match self.bindingIsLocked(name) {
217            Ok(xx) => {
218                if self.exists(name) && xx {
219                    return rraise(format!("binding_is_locked: {:?}", name));
220                }
221            }
222            Err(_) => {
223                return rraise(format!("no such binding: {:?}", name));
224            }
225        }
226        unsafe {
227            let name_sym = Rf_install(c_str(name).as_ptr());
228
229            Rf_defineVar(name_sym, x.s(), self.data.s());
230            Ok(())
231        }
232
233    }
234    pub fn is_locked(&self) -> bool {
235        unsafe { R_EnvironmentIsLocked(self.data.s()) == Rboolean::TRUE }
236    }
237
238    pub fn binding_is_active(&self, name: &str) -> RResult<bool> {
239        if !self.exists(name) {
240            return rraise(format!("no such binding: {:?}", name));
241        }
242        unsafe { Ok(R_BindingIsActive(Symbol::from(name).s(), self.data.s()) == Rboolean::TRUE) }
243    }
244    pub fn lock(&self, bindings: Rboolean) {
245        unsafe {
246            R_LockEnvironment(self.data.s(), bindings);
247        }
248    }
249
250    pub fn lock_binding(&self, name: &str) -> RResult<()> {
251        if !self.exists(name) {
252            return rraise(format!("no such binding: {:?}", name));
253        }
254        unsafe {
255            R_LockBinding(Symbol::from(name).s(), self.data.s());
256            Ok(())
257        }
258
259    }
260
261    pub fn unlock_binding(&self, name: &str) -> RResult<()> {
262        if !self.exists(name) {
263            return rraise(format!("no such binding: {:?}", name));
264        }
265        unsafe {
266            R_unLockBinding(Symbol::from(name).s(), self.data.s());
267            Ok(())
268        }
269    }
270    /**
271         * remove an object from this environment
272         */
273    pub fn remove(&self, name: &str) -> RResult<bool> {
274        if self.exists(name) {
275            let res1 = match self.bindingIsLocked(name) {
276                Ok(aa) => aa,
277                Err(_) => {
278                    return rraise(format!("no such binding: {:?}", name));
279                }
280            };
281            if res1 {
282                return rraise(format!("binding is locked: {}", name));
283            } else {
284                unsafe {
285                    // unless we want to copy all of do_remove,
286                    // we have to go back to R to do this operation
287                    let internal_sym = Rf_install(c_str(".Internal").as_ptr());
288                    let remove_sym = Rf_install(c_str("remove").as_ptr());
289                    let call = Shield::new(Rf_lang2(internal_sym,
290                                                    Rf_lang4(remove_sym,
291                                                             Rf_mkString(c_str(name).as_ptr()),
292                                                             self.data.s(),
293                                                             Rf_ScalarLogical(0))));
294                    Rf_eval(call.s(), R_GlobalEnv);
295                }
296
297            }
298        } else {
299            return rraise(format!("no such binding: {:?}", name));
300        }
301        Ok(true)
302
303    }
304}
rustr/environment.rs

rustr/
environment.rs
