Extract promises and their environments from ...

output.txt

> f <- function(...) {
+     promises(environment())
+ }

> g <- function(x = 3, ...) {
+     z <- 4
+     f(z = z, ..., x = x)
+ }

> h <- function(..., a = 2) {
+     g(..., a = a)
+ }

> y <- 2

> res <- h(y = y)

> res
$prom
$prom[[1]]
<promise: 0x104480ce0>

$prom[[2]]
<promise: 0x104481780>

$prom[[3]]
<promise: 0x104480a40>

$prom[[4]]
<promise: 0x104480e30>


$env
$env[[1]]
<environment: 0x104480bc8>

$env[[2]]
<environment: R_GlobalEnv>

$env[[3]]
<environment: 0x104481898>

$env[[4]]
<environment: 0x104480bc8>



> lapply(res$env, ls)
[[1]]
[1] "x" "z"

[[2]]
[1] "args"     "f"        "file"     "g"        "h"        "promises" "res"
[8] "y"

[[3]]
[1] "a"

[[4]]
[1] "x" "z"

promises.cpp

#include <Rcpp.h>
using namespace Rcpp ;

// [[Rcpp::export]]
List promises(Environment env){
  SEXP dots = Rf_findVar( R_DotsSymbol, env );
  
  std::vector<Promise> promises ;
  std::vector<Environment> environments ;
  
  SEXP p = dots ;
  while( p != R_NilValue){
    Promise prom = CAR(p) ;
    
    while(true){
        SEXP code = PRCODE(prom) ;
        if( TYPEOF(code) != PROMSXP ){
            break ;
        }
        prom = code ;
    }
    promises.push_back(prom) ;
    environments.push_back(prom.environment());
    
    p = CDR(p) ;    
  }
  return List::create( _["prom"] = promises, _["env"] = environments ) ;
}

/*** R

f <- function(...) {
    promises(environment())
}
g <- function(x = 3, ...){
    z <- 4
    f( z = z, ..., x = x )
}
h <- function(..., a = 2 ){
    g(..., a = a)
}
y <- 2
res <- h( y = y )
res
lapply(res$env, ls )

*/