1 #include "rlang.h"
2
3
r_eval_with_x(sexp * call,sexp * parent,sexp * x)4 sexp* r_eval_with_x(sexp* call, sexp* parent, sexp* x) {
5 sexp* env = KEEP(r_new_environment(parent, 1));
6 sexp* out = r_eval_in_with_x(call, env,
7 x, r_syms_x);
8
9 FREE(1);
10 return out;
11 }
r_eval_with_xy(sexp * call,sexp * parent,sexp * x,sexp * y)12 sexp* r_eval_with_xy(sexp* call, sexp* parent, sexp* x, sexp* y) {
13 sexp* env = KEEP(r_new_environment(parent, 1));
14 sexp* out = r_eval_in_with_xy(call, env,
15 x, r_syms_x,
16 y, r_syms_y);
17
18 FREE(1);
19 return out;
20 }
r_eval_with_xyz(sexp * call,sexp * parent,sexp * x,sexp * y,sexp * z)21 sexp* r_eval_with_xyz(sexp* call, sexp* parent, sexp* x, sexp* y, sexp* z) {
22 sexp* env = KEEP(r_new_environment(parent, 1));
23 sexp* out = r_eval_in_with_xyz(call, env,
24 x, r_syms_x,
25 y, r_syms_y,
26 z, r_syms_z);
27
28 FREE(1);
29 return out;
30 }
r_eval_with_wxyz(sexp * call,sexp * parent,sexp * w,sexp * x,sexp * y,sexp * z)31 sexp* r_eval_with_wxyz(sexp* call, sexp* parent, sexp* w, sexp* x, sexp* y, sexp* z) {
32 sexp* env = KEEP(r_new_environment(parent, 1));
33 sexp* out = r_eval_in_with_wxyz(call, env,
34 w, r_syms_w,
35 x, r_syms_x,
36 y, r_syms_y,
37 z, r_syms_z);
38
39 FREE(1);
40 return out;
41 }
42
r_eval_in_with_x(sexp * call,sexp * env,sexp * x,sexp * x_sym)43 sexp* r_eval_in_with_x(sexp* call, sexp* env,
44 sexp* x, sexp* x_sym) {
45 r_env_poke(env, x_sym, x);
46 return r_eval(call, env);
47 }
r_eval_in_with_xy(sexp * call,sexp * env,sexp * x,sexp * x_sym,sexp * y,sexp * y_sym)48 sexp* r_eval_in_with_xy(sexp* call, sexp* env,
49 sexp* x, sexp* x_sym,
50 sexp* y, sexp* y_sym) {
51 r_env_poke(env, x_sym, x);
52 r_env_poke(env, y_sym, y);
53 return r_eval(call, env);
54 }
r_eval_in_with_xyz(sexp * call,sexp * env,sexp * x,sexp * x_sym,sexp * y,sexp * y_sym,sexp * z,sexp * z_sym)55 sexp* r_eval_in_with_xyz(sexp* call, sexp* env,
56 sexp* x, sexp* x_sym,
57 sexp* y, sexp* y_sym,
58 sexp* z, sexp* z_sym) {
59 r_env_poke(env, x_sym, x);
60 r_env_poke(env, y_sym, y);
61 r_env_poke(env, z_sym, z);
62 return r_eval(call, env);
63 }
r_eval_in_with_wxyz(sexp * call,sexp * env,sexp * w,sexp * w_sym,sexp * x,sexp * x_sym,sexp * y,sexp * y_sym,sexp * z,sexp * z_sym)64 sexp* r_eval_in_with_wxyz(sexp* call, sexp* env,
65 sexp* w, sexp* w_sym,
66 sexp* x, sexp* x_sym,
67 sexp* y, sexp* y_sym,
68 sexp* z, sexp* z_sym) {
69 r_env_poke(env, w_sym, w);
70 r_env_poke(env, x_sym, x);
71 r_env_poke(env, y_sym, y);
72 r_env_poke(env, z_sym, z);
73 return r_eval(call, env);
74 }
75
76 static sexp* shared_x_env;
77 static sexp* shared_xy_env;
78 static sexp* shared_xyz_env;
79
80 // Evaluate call with a preallocated environment containing a single
81 // `x` binding and inheriting from base env.
82 //
83 // Since this has side effects, it should not be used when there is a
84 // chance of recursing into the C library. It should only be used to
85 // evaluate pure R calls or functions from other packages, such as the
86 // base package.
eval_with_x(sexp * call,sexp * x)87 sexp* eval_with_x(sexp* call, sexp* x) {
88 r_env_poke(shared_x_env, r_syms_x, x);
89
90 sexp* out = KEEP(r_eval(call, shared_x_env));
91
92 // Release for gc
93 r_env_poke(shared_x_env, r_syms_x, r_null);
94
95 FREE(1);
96 return out;
97 }
98
eval_with_xy(sexp * call,sexp * x,sexp * y)99 sexp* eval_with_xy(sexp* call, sexp* x, sexp* y) {
100 r_env_poke(shared_xy_env, r_syms_x, x);
101 r_env_poke(shared_xy_env, r_syms_y, y);
102
103 sexp* out = KEEP(r_eval(call, shared_xy_env));
104
105 // Release for gc
106 r_env_poke(shared_xy_env, r_syms_x, r_null);
107 r_env_poke(shared_xy_env, r_syms_y, r_null);
108
109 FREE(1);
110 return out;
111 }
112
eval_with_xyz(sexp * call,sexp * x,sexp * y,sexp * z)113 sexp* eval_with_xyz(sexp* call, sexp* x, sexp* y, sexp* z) {
114 r_env_poke(shared_xyz_env, r_syms_x, x);
115 r_env_poke(shared_xyz_env, r_syms_y, y);
116 r_env_poke(shared_xyz_env, r_syms_z, z);
117
118 sexp* out = KEEP(r_eval(call, shared_xyz_env));
119
120 // Release for gc
121 r_env_poke(shared_xyz_env, r_syms_x, r_null);
122 r_env_poke(shared_xyz_env, r_syms_y, r_null);
123 r_env_poke(shared_xyz_env, r_syms_z, r_null);
124
125 FREE(1);
126 return out;
127 }
128