Use new R_GetBindingType() utilities

src/rlang/decl/env-decl.h

@@ -39,6 +39,3 @@ r_obj* missing_prim;
 static
 r_obj* env_as_list_compat(r_obj* env, r_obj* out);
 #endif
-
-static
-void env_coalesce_plain(r_obj* env, r_obj* from, r_obj* nms);

src/rlang/env-binding.c

@@ -1,15 +1,6 @@
 #include "rlang.h"
-#include "env.h"
 
 
-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;
-}
-bool r_env_binding_is_active(r_obj* env, r_obj* sym) {
-  return R_BindingIsActive(sym, env);
-}
-
 static r_obj* new_binding_types(r_ssize n) {
   r_obj* types = r_alloc_integer(n);
 
@@ -20,17 +11,11 @@ static r_obj* new_binding_types(r_ssize n) {
 }
 
 static enum r_env_binding_type which_env_binding(r_obj* env, r_obj* sym) {
-  if (r_env_binding_is_active(env, sym)) {
-    // Check for active bindings first, since promise detection triggers
-    // active bindings through `r_env_find()` (#1376)
-    return R_ENV_BINDING_TYPE_active;
+  switch (R_GetBindingType(sym, env)) {
+    case R_BindingTypeActive: return R_ENV_BINDING_TYPE_active;
+    case R_BindingTypeDelayed: return R_ENV_BINDING_TYPE_promise;
+    default: return R_ENV_BINDING_TYPE_value;
   }
-
-  if (r_env_binding_is_promise(env, sym)) {
-    return R_ENV_BINDING_TYPE_promise;
-  }
-
-  return R_ENV_BINDING_TYPE_value;
 }
 
 static inline r_obj* binding_as_sym(bool list, r_obj* bindings, r_ssize i) {

src/rlang/env-binding.h

@@ -11,8 +11,6 @@ enum r_env_binding_type {
   R_ENV_BINDING_TYPE_active
 };
 
-bool r_env_binding_is_promise(r_obj* env, r_obj* sym);
-bool r_env_binding_is_active(r_obj* env, r_obj* sym);
 r_obj* r_env_binding_types(r_obj* env, r_obj* bindings);
 
 

src/rlang/env.c

@@ -108,6 +108,56 @@ r_obj* r_env_clone(r_obj* env, r_obj* parent) {
   return out;
 }
 
+#if R_VERSION >= R_Version(4, 6, 0)
+void r_env_coalesce(r_obj* env, r_obj* from) {
+  r_obj* nms = KEEP(r_env_names(from));
+  r_ssize n = r_length(nms);
+  r_obj* const * v_nms = r_chr_cbegin(nms);
+
+  for (r_ssize i = 0; i < n; ++i) {
+    r_obj* sym = r_str_as_symbol(v_nms[i]);
+
+    if (r_env_has(env, sym)) {
+      // Already in `env`
+      continue;
+    }
+
+    // Otherwise copy it over
+    switch (R_GetBindingType(sym, from)) {
+    case R_BindingTypeUnbound: {
+      r_stop_internal("Got names from `from`");
+    }
+
+    case R_BindingTypeValue:
+    case R_BindingTypeForced: {
+      r_env_poke(env, sym, r_env_get(from, sym));
+      break;
+    }
+
+    case R_BindingTypeMissing: {
+      R_MakeMissingBinding(sym, env);
+      break;
+    }
+
+    case R_BindingTypeDelayed: {
+      r_obj* expr = R_DelayedBindingExpression(sym, from);
+      r_obj* eval_env = R_DelayedBindingEnvironment(sym, from);
+      R_MakeDelayedBinding(sym, expr, eval_env, env);
+      break;
+    }
+
+    case R_BindingTypeActive: {
+      r_obj* fn = R_ActiveBindingFunction(sym, from);
+      r_env_poke_active(env, sym, fn);
+      break;
+    }
+    }
+  }
+
+  FREE(1);
+}
+
+#else
 void r_env_coalesce(r_obj* env, r_obj* from) {
   r_obj* nms = KEEP(r_env_names(from));
   r_obj* types = KEEP(r_env_binding_types(from, nms));
@@ -140,10 +190,14 @@ void r_env_coalesce(r_obj* env, r_obj* from) {
 
     switch (v_types[i]) {
     case R_ENV_BINDING_TYPE_value:
-    case R_ENV_BINDING_TYPE_promise:
       r_env_poke(env, sym, r_env_find(from, sym));
       break;
 
+    case R_ENV_BINDING_TYPE_promise:
+      r_obj* promise = r_env_find(from, sym);
+      r_env_poke(env, sym, r_clone(promise));
+      break;
+
     case R_ENV_BINDING_TYPE_active: {
 #if R_VERSION < R_Version(4, 0, 0)
       r_ssize fn_idx = r_chr_detect_index(nms, r_sym_c_string(sym));
@@ -162,24 +216,7 @@ void r_env_coalesce(r_obj* env, r_obj* from) {
   FREE(3);
   return;
 }
-
-static
-void env_coalesce_plain(r_obj* env, r_obj* from, r_obj* nms) {
-  r_ssize n = r_length(nms);
-  r_obj* const * v_nms = r_chr_cbegin(nms);
-
-  for (r_ssize i = 0; i < n; ++i) {
-    r_obj* sym = r_str_as_symbol(v_nms[i]);
-
-    if (r_env_has(env, sym)) {
-      continue;
-    }
-
-    r_env_poke(env, sym, r_env_find(from, sym));
-  }
-
-  return;
-}
+#endif
 
 r_obj* r_list_as_environment(r_obj* x, r_obj* parent) {
   parent = parent ? parent : r_envs.empty;

tests/testthat/test-env.R

@@ -460,8 +460,8 @@ test_that("env_coalesce() handles fancy bindings", {
   expect_equal(x$active, "active-value")
   expect_equal(x$lazy, "lazy-value")
 
-  # `y$lazy` was forced at the same time as `x$lazy`
-  expect_false(env_binding_are_lazy(y, "lazy"))
+  # Forcing `x$lazy` does not force `y$lazy`
+  expect_true(env_binding_are_lazy(y, "lazy"))
 
   expect_condition(
     expect_equal(y$active, "active-value"),