SEXP RKStructureGetter::resolvePromise (SEXP from) {
RK_TRACE (RBACKEND);
SEXP ret = from;
if (TYPEOF (from) == PROMSXP) {
ret = PRVALUE(from);
if (ret == R_UnboundValue) {
RK_DEBUG (RBACKEND, DL_DEBUG, "temporarily resolving unbound promise");
PROTECT (from);
SET_PRSEEN(from, 1);
ret = Rf_eval(PRCODE(from), PRENV(from));
SET_PRSEEN(from, 0);
if (keep_evalled_promises) {
SET_PRVALUE(from, ret);
SET_PRENV(from, R_NilValue);
}
UNPROTECT (1);
RK_DEBUG (RBACKEND, DL_DEBUG, "resolved type is %d", TYPEOF (ret));
}
}
return ret;
}
SEXP _as_dots_literal(SEXP list) {
assert_type(list, VECSXP);
int len = LENGTH(list);
SEXP dotlist;
if (len == 0) {
dotlist = PROTECT(allocVector(VECSXP, 0));
setAttrib(dotlist, R_ClassSymbol, ScalarString(mkChar("...")));
UNPROTECT(1);
return dotlist;
} else {
dotlist = PROTECT(allocate_dots(len));
}
SEXP names = getAttrib(list, R_NamesSymbol);
int i;
SEXP iter;
for (i = 0, iter = dotlist;
iter != R_NilValue && i < len;
i++, iter = CDR(iter)) {
assert_type(CAR(iter), PROMSXP);
SET_PRVALUE(CAR(iter), VECTOR_ELT(list, i));
SET_PRCODE(CAR(iter), VECTOR_ELT(list, i));
SET_PRENV(CAR(iter), R_NilValue);
if ((names != R_NilValue) && (STRING_ELT(names, i) != R_BlankString)) {
SET_TAG(iter, install(CHAR(STRING_ELT(names, i)) ));
}
}
setAttrib(dotlist, R_ClassSymbol, ScalarString(mkChar("...")));
UNPROTECT(1);
return dotlist;
}
/* Version of DispatchOrEval for "[" and friends that speeds up simple cases.
Also defined in subassign.c */
static R_INLINE
int R_DispatchOrEvalSP(SEXP call, SEXP op, const char *generic, SEXP args,
SEXP rho, SEXP *ans)
{
SEXP prom = NULL;
if (args != R_NilValue && CAR(args) != R_DotsSymbol) {
SEXP x = eval(CAR(args), rho);
PROTECT(x);
if (! OBJECT(x)) {
*ans = CONS_NR(x, evalListKeepMissing(CDR(args), rho));
UNPROTECT(1);
return FALSE;
}
prom = mkPROMISE(CAR(args), R_GlobalEnv);
SET_PRVALUE(prom, x);
args = CONS(prom, CDR(args));
UNPROTECT(1);
}
PROTECT(args);
int disp = DispatchOrEval(call, op, generic, args, rho, ans, 0, 0);
if (prom) DECREMENT_REFCNT(PRVALUE(prom));
UNPROTECT(1);
return disp;
}
