Add promise accessors

Author: DavisVaughan

src/include/Rinternals.h

@@ -723,6 +723,9 @@ void R_MakeActiveBinding(SEXP sym, SEXP fun, SEXP env);
 Rboolean R_BindingIsLocked(SEXP sym, SEXP env); // envir.c
 Rboolean R_BindingIsActive(SEXP sym, SEXP env); // envir.c
 SEXP R_ActiveBindingFunction(SEXP sym, SEXP env);
+SEXP R_DelayedPromiseBindingExpression(SEXP sym, SEXP env);
+SEXP R_DelayedPromiseBindingEnvironment(SEXP sym, SEXP env);
+SEXP R_ForcedPromiseBindingExpression(SEXP sym, SEXP env);
 Rboolean R_HasFancyBindings(SEXP rho); // envir.c
 
 

src/main/envir.c

@@ -3590,6 +3590,45 @@ attribute_hidden Rboolean R_HasFancyBindings(SEXP rho)
     }
 }
 
+// Equivalent to `substitute()`, but only supports promises
+SEXP R_DelayedPromiseBindingExpression(SEXP sym, SEXP env) {
+    SEXP value = Rf_findVarInFrame3(env, sym, FALSE);
+
+    if (TYPEOF(value) != PROMSXP)
+        error(_("not a promise"));
+
+    if (PROMISE_IS_EVALUATED(value))
+        error(_("not a delayed promise"));
+
+    // This has special handling for bytecode, unlike `PREXPR()`
+    return R_PromiseExpr(value);
+}
+
+SEXP R_DelayedPromiseBindingEnvironment(SEXP sym, SEXP env) {
+    SEXP value = Rf_findVarInFrame3(env, sym, FALSE);
+
+    if (TYPEOF(value) != PROMSXP)
+        error(_("not a promise"));
+
+    if (PROMISE_IS_EVALUATED(value))
+        error(_("not a delayed promise"));
+
+    return PRENV(value);
+}
+
+SEXP R_ForcedPromiseBindingExpression(SEXP sym, SEXP env) {
+    SEXP value = Rf_findVarInFrame3(env, sym, FALSE);
+
+    if (TYPEOF(value) != PROMSXP)
+        error(_("not a promise"));
+
+    if (!PROMISE_IS_EVALUATED(value))
+        error(_("not a forced promise"));
+
+    // This has special handling for bytecode, unlike `PREXPR()`
+    return R_PromiseExpr(value);
+}
+
 SEXP R_ActiveBindingFunction(SEXP sym, SEXP env)
 {
     if (TYPEOF(sym) != SYMSXP)