Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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
You can’t perform that action at this time.