Extract promises and their environments from ...
> 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" |
#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 ) | |
*/ |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment