1 #ifndef RLANG_ENV_H
2 #define RLANG_ENV_H
3
4 #include <stdbool.h>
5 #include <Rversion.h>
6
7
8 #define r_global_env R_GlobalEnv
9 #define r_base_env R_BaseEnv
10 #define r_empty_env R_EmptyEnv
11
12 extern sexp* r_methods_ns_env;
13
14
15 #if (!defined(R_VERSION) || R_VERSION < R_Version(3, 2, 0))
r_env_names(sexp * env)16 static inline sexp* r_env_names(sexp* env) {
17 return R_lsInternal(env, true);
18 }
19 #else
r_env_names(sexp * env)20 static inline sexp* r_env_names(sexp* env) {
21 return R_lsInternal3(env, true, false);
22 }
23 #endif
24
r_env_length(sexp * env)25 static inline r_ssize r_env_length(sexp* env) {
26 if (r_typeof(env) != r_type_environment) {
27 r_abort("Expected an environment");
28 }
29 return Rf_xlength(env);
30 }
31
r_env_parent(sexp * env)32 static inline sexp* r_env_parent(sexp* env) {
33 return ENCLOS(env);
34 }
r_env_poke_parent(sexp * env,sexp * new_parent)35 static inline void r_env_poke_parent(sexp* env, sexp* new_parent) {
36 SET_ENCLOS(env, new_parent);
37 }
38
r_is_environment(sexp * x)39 static inline bool r_is_environment(sexp* x) {
40 return TYPEOF(x) == ENVSXP;
41 }
r_is_namespace(sexp * x)42 static inline bool r_is_namespace(sexp* x) {
43 return R_IsNamespaceEnv(x);
44 }
45
r_env_find(sexp * env,sexp * sym)46 static inline sexp* r_env_find(sexp* env, sexp* sym) {
47 return Rf_findVarInFrame3(env, sym, FALSE);
48 }
r_env_find_anywhere(sexp * env,sexp * sym)49 static inline sexp* r_env_find_anywhere(sexp* env, sexp* sym) {
50 return Rf_findVar(sym, env);
51 }
52
r_env_has(sexp * env,sexp * sym)53 static inline bool r_env_has(sexp* env, sexp* sym) {
54 return r_env_find(env, sym) != r_syms_unbound;
55 }
r_env_has_anywhere(sexp * env,sexp * sym)56 static inline bool r_env_has_anywhere(sexp* env, sexp* sym) {
57 return r_env_find_anywhere(env, sym) != r_syms_unbound;
58 }
59
60 sexp* r_ns_env(const char* pkg);
61 sexp* r_base_ns_get(const char* name);
62
63 sexp* r_new_environment(sexp* parent, r_ssize size);
64
65 sexp* r_env_as_list(sexp* x);
66 sexp* r_list_as_environment(sexp* x, sexp* parent);
67 sexp* r_env_clone(sexp* env, sexp* parent);
68
69
70 static inline
r_env_unbind(sexp * env,sexp * sym)71 void r_env_unbind(sexp* env, sexp* sym) {
72 #if (R_VERSION < R_Version(4, 0, 0))
73 void r__env_unbind(sexp*, sexp*);
74 r__env_unbind(env, sym);
75 #else
76 R_removeVarFromFrame(sym, env);
77 #endif
78 }
79 void r_env_unbind_anywhere(sexp* env, sexp* sym);
80
81 void r_env_unbind_syms(sexp* env, sexp** syms);
82 void r_env_unbind_string(sexp* env, const char* name);
83 void r_env_unbind_strings(sexp* env, const char** strings);
84 void r_env_unbind_names(sexp* env, sexp* names);
85
86 void r_env_unbind_string_anywhere(sexp* env, const char* name);
87 void r_env_unbind_anywhere_names(sexp* env, sexp* names);
88 void r_env_unbind_anywhere_strings(sexp* env, const char** names);
89
r_env_poke(sexp * env,sexp * sym,sexp * value)90 static inline sexp* r_env_poke(sexp* env, sexp* sym, sexp* value) {
91 Rf_defineVar(sym, value, env);
92 return env;
93 }
94 void r_env_poke_lazy(sexp* env, sexp* sym, sexp* expr, sexp* eval_env);
95
96 static inline
r_env_poke_active(sexp * env,sexp * sym,sexp * fn)97 void r_env_poke_active(sexp* env, sexp* sym, sexp* fn) {
98 if (r_env_has(env, sym)) {
99 r_env_unbind(env, sym);
100 }
101 R_MakeActiveBinding(sym, fn, env);
102 }
103
104 bool r_env_inherits(sexp* env, sexp* ancestor, sexp* top);
105
106
107 #endif
108