diff --git a/src/capture.c b/src/capture.c index 86599ddc6..3e4404bee 100644 --- a/src/capture.c +++ b/src/capture.c @@ -4,6 +4,8 @@ #define attribute_hidden #define _(string) (string) +#define RLANG_PRENV(x) TAG(x) +#define RLANG_PREXPR(x) R_BytecodeExpr(CDR(x)) static Rboolean dotDotVal(SEXP); static SEXP capturedot(SEXP, int); @@ -36,8 +38,8 @@ SEXP attribute_hidden new_captured_promise(SEXP x, SEXP env) { SEXP expr = x; while (TYPEOF(expr) == PROMSXP) { - expr_env = PRENV(expr); - expr = PREXPR(expr); + expr_env = RLANG_PRENV(expr); + expr = RLANG_PREXPR(expr); if (expr_env == R_NilValue) break; @@ -77,7 +79,7 @@ SEXP attribute_hidden rlang_capturearginfo(SEXP call, SEXP op, SEXP args, SEXP r return value; } - sym = PREXPR(sym); + sym = RLANG_PREXPR(sym); if (TYPEOF(sym) != SYMSXP) { UNPROTECT(nProt); diff --git a/src/internal/dots-ellipsis.c b/src/internal/dots-ellipsis.c index dd358b7ac..6d8170f65 100644 --- a/src/internal/dots-ellipsis.c +++ b/src/internal/dots-ellipsis.c @@ -53,7 +53,7 @@ bool ellipsis_promise_forced(r_obj* x) { if (r_typeof(x) != R_TYPE_promise) { return true; } else { - return PRVALUE(x) != r_syms.unbound; + return RLANG_PRVALUE(x) != r_syms.unbound; } } r_obj* ffi_ellipsis_promise_forced(r_obj* x) { diff --git a/src/internal/exported.c b/src/internal/exported.c index d48ccd5f8..83a001f6f 100644 --- a/src/internal/exported.c +++ b/src/internal/exported.c @@ -472,15 +472,15 @@ r_obj* ffi_env_poke_parent(r_obj* env, r_obj* new_parent) { r_abort("Can't change the parent of the empty environment"); } - SET_ENCLOS(env, new_parent); + RLANG_SET_ENCLOS(env, new_parent); return env; } r_obj* ffi_env_frame(r_obj* env) { - return FRAME(env); + return RLANG_FRAME(env); } r_obj* ffi_env_hash_table(r_obj* env) { - return HASHTAB(env); + return RLANG_HASHTAB(env); } r_obj* ffi_env_inherits(r_obj* env, r_obj* ancestor) { @@ -771,15 +771,15 @@ r_obj* rlang_get_promise(r_obj* x, r_obj* env) { r_obj* ffi_promise_expr(r_obj* x, r_obj* env) { r_obj* prom = rlang_get_promise(x, env); - return PREXPR(prom); + return RLANG_PREXPR(prom); } r_obj* ffi_promise_env(r_obj* x, r_obj* env) { r_obj* prom = rlang_get_promise(x, env); - return PRENV(prom); + return RLANG_PRENV(prom); } r_obj* ffi_promise_value(r_obj* x, r_obj* env) { r_obj* prom = rlang_get_promise(x, env); - r_obj* value = PRVALUE(prom); + r_obj* value = RLANG_PRVALUE(prom); if (value == r_syms.unbound) { return r_sym("R_UnboundValue"); } else { diff --git a/src/rlang/env-binding.c b/src/rlang/env-binding.c index 8e38c675c..eba06507d 100644 --- a/src/rlang/env-binding.c +++ b/src/rlang/env-binding.c @@ -4,7 +4,7 @@ bool r_env_binding_is_promise(r_obj* env, r_obj* sym) { r_obj* obj = r_env_find(env, sym); - return r_typeof(obj) == R_TYPE_promise && PRVALUE(obj) == r_syms.unbound; + return r_typeof(obj) == R_TYPE_promise && RLANG_PRVALUE(obj) == r_syms.unbound; } bool r_env_binding_is_active(r_obj* env, r_obj* sym) { return R_BindingIsActive(sym, env); diff --git a/src/rlang/env.h b/src/rlang/env.h index 1994552dd..1bc4706f2 100644 --- a/src/rlang/env.h +++ b/src/rlang/env.h @@ -34,7 +34,7 @@ r_obj* r_env_parent(r_obj* env) { } static inline void r_env_poke_parent(r_obj* env, r_obj* new_parent) { - SET_ENCLOS(env, new_parent); + RLANG_SET_ENCLOS(env, new_parent); } static inline diff --git a/src/rlang/fn.h b/src/rlang/fn.h index b2858c928..0b1eca636 100644 --- a/src/rlang/fn.h +++ b/src/rlang/fn.h @@ -12,7 +12,7 @@ r_obj* r_fn_body(r_obj* fn) { } static inline void r_fn_poke_body(r_obj* fn, r_obj* body) { - SET_BODY(fn, body); + RLANG_SET_BODY(fn, body); } static inline @@ -21,15 +21,15 @@ r_obj* r_fn_env(r_obj* fn) { } static inline void r_fn_poke_env(r_obj* fn, r_obj* env) { - SET_CLOENV(fn, env); + RLANG_SET_CLOENV(fn, env); } static inline r_obj* r_new_function(r_obj* formals, r_obj* body, r_obj* env) { SEXP fn = Rf_allocSExp(R_TYPE_closure); - SET_FORMALS(fn, formals); - SET_BODY(fn, body); - SET_CLOENV(fn, env); + RLANG_SET_FORMALS(fn, formals); + RLANG_SET_BODY(fn, body); + RLANG_SET_CLOENV(fn, env); return fn; } diff --git a/src/rlang/rlang-types.h b/src/rlang/rlang-types.h index bd1b2ae68..40ed936da 100644 --- a/src/rlang/rlang-types.h +++ b/src/rlang/rlang-types.h @@ -114,8 +114,16 @@ struct r_lazy { FREE(1); \ } while (0) - #define RLANG_ASSERT(condition) ((void)sizeof(char[1 - 2*!(condition)])) +#define RLANG_FRAME(x) CAR(x) +#define RLANG_HASHTAB(x) TAG(x) +#define RLANG_PRENV(x) TAG(x) +#define RLANG_PREXPR(x) R_BytecodeExpr(CDR(x)) +#define RLANG_PRVALUE(x) CAR(x) +#define RLANG_SET_ENCLOS(x, v) SETCDR(x, v) +#define RLANG_SET_FORMALS(x, v) SETCAR(x, v) +#define RLANG_SET_BODY(x, v) SETCDR(x, v) +#define RLANG_SET_CLOENV(x, v) SET_TAG(x, v) #endif diff --git a/src/rlang/walk.c b/src/rlang/walk.c index d24e895ce..25844254a 100644 --- a/src/rlang/walk.c +++ b/src/rlang/walk.c @@ -105,7 +105,7 @@ struct r_sexp_iterator* r_new_sexp_iterator(r_obj* root) { .x = r_null, .parent = r_null, }; - + FREE(1); return p_it; } @@ -315,8 +315,8 @@ r_obj* sexp_node_car(enum r_type type, enum r_sexp_it_relation* p_rel) { switch (type) { case R_TYPE_closure: *p_rel = R_SEXP_IT_RELATION_function_fmls; return FORMALS(x); - case R_TYPE_environment: *p_rel = R_SEXP_IT_RELATION_environment_frame; return FRAME(x); - case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_value; return PRVALUE(x); + case R_TYPE_environment: *p_rel = R_SEXP_IT_RELATION_environment_frame; return RLANG_FRAME(x); + case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_value; return RLANG_PRVALUE(x); case R_TYPE_pairlist: case R_TYPE_call: case R_TYPE_dots: *p_rel = R_SEXP_IT_RELATION_node_car; return CAR(x); @@ -331,7 +331,7 @@ r_obj* sexp_node_cdr(enum r_type type, switch (type) { case R_TYPE_closure: *p_rel = R_SEXP_IT_RELATION_function_body; return BODY(x); case R_TYPE_environment: *p_rel = R_SEXP_IT_RELATION_environment_enclos; return ENCLOS(x); - case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_expr; return PREXPR(x); + case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_expr; return RLANG_PREXPR(x); case R_TYPE_pointer: *p_rel = R_SEXP_IT_RELATION_pointer_prot; return EXTPTR_PROT(x); case R_TYPE_pairlist: case R_TYPE_call: @@ -345,8 +345,8 @@ r_obj* sexp_node_tag(enum r_type type, enum r_sexp_it_relation* p_rel) { switch (type) { case R_TYPE_closure: *p_rel = R_SEXP_IT_RELATION_function_env; return CLOENV(x); - case R_TYPE_environment: *p_rel = R_SEXP_IT_RELATION_environment_hashtab; return HASHTAB(x); - case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_env; return PRENV(x); + case R_TYPE_environment: *p_rel = R_SEXP_IT_RELATION_environment_hashtab; return RLANG_HASHTAB(x); + case R_TYPE_promise: *p_rel = R_SEXP_IT_RELATION_promise_env; return RLANG_PRENV(x); case R_TYPE_pointer: *p_rel = R_SEXP_IT_RELATION_pointer_tag; return EXTPTR_TAG(x); case R_TYPE_pairlist: case R_TYPE_call: