bool Promise::isMissingSymbol() const
{
bool ans = false;
/* This is wrong but I'm not clear why - arr
if (m_value == Symbol::missingArgument())
return true;
*/
if (m_value == Symbol::unboundValue() && m_valgen) {
RObject* prexpr = PREXPR(const_cast<Promise*>(this));
if (prexpr->sexptype() == SYMSXP) {
// According to Luke Tierney's comment to R_isMissing() in CR,
// if a cycle is found then a missing argument has been
// encountered, so the return value is true.
if (m_under_evaluation)
return true;
try {
const Symbol* promsym
= static_cast<const Symbol*>(prexpr);
m_under_evaluation = true;
ans = isMissingArgument(promsym, environment()->frame());
}
catch (...) {
m_under_evaluation = false;
throw;
}
m_under_evaluation = false;
}
}
return ans;
}
pair<bool, RObject*> ArgList::firstArg(Environment* env)
{
const PairList* elt = list();
if (!elt)
return pair<bool, RObject*>(false, 0);
if (m_status == EVALUATED)
return make_pair(true, elt->car());
while (elt) {
RObject* arg1 = elt->car();
if (!arg1)
return pair<bool, RObject*>(true, 0);
if (arg1 != DotsSymbol) {
m_first_arg = Evaluator::evaluate(arg1, env);
m_first_arg_env = env;
return make_pair(true, m_first_arg.get());
}
// If we get here it must be DotSymbol.
Frame::Binding* bdg = env->findBinding(DotsSymbol);
if (bdg && bdg->origin() != Frame::Binding::MISSING) {
RObject* val = bdg->forcedValue();
if (val) {
if (val->sexptype() != DOTSXP)
Rf_error(_("'...' used in an incorrect context"));
RObject* dots1 = static_cast<DottedArgs*>(val)->car();
if (dots1->sexptype() != PROMSXP)
Rf_error(_("value in '...' is not a promise"));
m_first_arg = Evaluator::evaluate(dots1, env);
m_first_arg_env = env;
return make_pair(true, m_first_arg.get());
}
}
elt = elt->tail(); // elt was unbound or missing DotsSymbol
}
return pair<bool, RObject*>(false, 0);
}
void Subscripting::setVectorAttributes(VectorBase* subset,
const VectorBase* source,
const Indices& indices)
{
// Names:
{
const StringVector* sourcenames = source->names();
if (!sourcenames) {
// Use row names if this is a one-dimensional array:
const ListVector* dimnames = source->dimensionNames();
if (dimnames && dimnames->size() == 1)
sourcenames = static_cast<const StringVector*>((*dimnames)[0].get());
}
if (sourcenames)
subset->setNames(vectorSubset(sourcenames, indices));
}
// R_SrcrefSymbol:
{
RObject* attrib = source->getAttribute(SrcrefSymbol);
if (attrib && attrib->sexptype() == VECSXP) {
const ListVector* srcrefs = static_cast<const ListVector*>(attrib);
subset->setAttribute(SrcrefSymbol, vectorSubset(srcrefs, indices));
}
}
}
std::pair<FunctionBase*, bool>
S3Launcher::findMethod(const Symbol* symbol, Environment* call_env,
Environment* table_env)
{
FunctionBase* fun = findFunction(symbol, call_env);
if (fun)
return make_pair(fun, true);
if (!table_env)
return pair<FunctionBase*, bool>(nullptr, false);
Environment* table = nullptr;
// Look for S3 methods table:
{
Frame::Binding* tblbdg
= table_env->frame()->binding(S3MethodsTableSymbol);
if (tblbdg) {
RObject* tblbdgval = tblbdg->forcedValue();
if (tblbdgval && tblbdgval->sexptype() == ENVSXP)
table = static_cast<Environment*>(tblbdgval);
}
}
// Look up method in table:
if (table) {
Frame::Binding* symbdg = table->frame()->binding(symbol);
if (symbdg) {
RObject* symbdgval = symbdg->forcedValue();
// Assume that the result is a FunctionBase:
return make_pair(static_cast<FunctionBase*>(symbdgval), false);
}
}
return pair<FunctionBase*, bool>(nullptr, false);
}
void ArgList::wrapInPromises(Environment* env)
{
if (m_status == PROMISED)
Rf_error("Internal error:"
" ArgList already wrapped in Promises");
if (m_status == EVALUATED)
env = 0;
else if (m_first_arg_env && env != m_first_arg_env)
Rf_error("Internal error: first arg of ArgList"
" previously evaluated in different environment");
GCStackRoot<const PairList> oldargs(list());
setList(0);
PairList* lastout = 0;
for (const PairList* inp = oldargs; inp; inp = inp->tail()) {
RObject* rawvalue = inp->car();
if (rawvalue == DotsSymbol) {
Frame::Binding* binding = env->findBinding(DotsSymbol);
if (binding) {
RObject* dval = binding->forcedValue();
if (!dval || dval->sexptype() == DOTSXP) {
ConsCell* dotlist = static_cast<ConsCell*>(dval);
while (dotlist) {
Promise* prom;
if (!m_first_arg_env)
prom = new Promise(dotlist->car(), env);
else {
prom = new Promise(m_first_arg, 0);
m_first_arg = 0;
m_first_arg_env = 0;
}
prom->expose();
const Symbol* tag = tag2Symbol(dotlist->tag());
PairList* cell = PairList::cons(prom, 0, tag);
lastout = append(cell, lastout);
dotlist = dotlist->tail();
}
} else if (dval != Symbol::missingArgument())
Rf_error(_("'...' used in an incorrect context"));
}
} else {
const Symbol* tag = tag2Symbol(inp->tag());
RObject* value = Symbol::missingArgument();
if (m_first_arg_env) {
value = CXXR_NEW(Promise(m_first_arg, 0));
m_first_arg = 0;
m_first_arg_env = 0;
} else if (rawvalue != Symbol::missingArgument())
value = CXXR_NEW(Promise(rawvalue, env));
PairList* cell = PairList::cons(value, 0, tag);
lastout = append(cell, lastout);
}
}
m_status = PROMISED;
}
RObject* Closure::execute(Environment* env) const
{
RObject* ans;
Evaluator::maybeCheckForUserInterrupts();
Environment::ReturnScope returnscope(env);
Closure::DebugScope debugscope(this);
try {
++m_num_invokes;
#ifdef ENABLE_LLVM_JIT
if (m_compiled_body
&& m_compiled_body->hasMatchingFrameLayout(env)) {
PlainContext boctxt;
ans = m_compiled_body->evalInEnvironment(env);
} else {
if (!m_compiled_body && m_num_invokes == 100) {
// Compile the body, but stay in the interpreter because the
// frame hasn't been setup for a compiled function.
// TODO(kmillar): recompile functions as needed.
compile();
}
#endif
BailoutContext boctxt;
ans = Evaluator::evaluate(m_body, env);
#ifdef ENABLE_LLVM_JIT
}
#endif
if (ans && ans->sexptype() == BAILSXP) {
ReturnBailout* rbo = dynamic_cast<ReturnBailout*>(ans);
if (!rbo || rbo->environment() != env)
abort();
R_Visible = Rboolean(rbo->printResult());
ans = rbo->value();
}
}
catch (ReturnException& rx) {
if (rx.environment() != env)
throw;
ans = rx.value();
}
return ans;
}
RObject* Expression::evaluate(Environment* env)
{
IncrementStackDepthScope scope;
GCStackRoot<FunctionBase> func;
RObject* head = car();
if (head->sexptype() == SYMSXP) {
Symbol* symbol = static_cast<Symbol*>(head);
func = findFunction(symbol, env);
if (!func)
error(_("could not find function \"%s\""),
symbol->name()->c_str());
} else {
RObject* val = Evaluator::evaluate(head, env);
if (!FunctionBase::isA(val))
error(_("attempt to apply non-function"));
func = static_cast<FunctionBase*>(val);
}
func->maybeTrace(this);
ArgList arglist(tail(), ArgList::RAW);
return func->apply(&arglist, env, this);
}
void ArgList::evaluate(Environment* env, bool allow_missing)
{
if (m_status == EVALUATED)
Rf_error("Internal error: ArgList already evaluated");
if (m_first_arg_env && env != m_first_arg_env)
Rf_error("Internal error: first arg of ArgList"
" previously evaluated in different environment");
GCStackRoot<const PairList> oldargs(list());
setList(0);
PairList* lastout = 0;
unsigned int arg_number = 1;
for (const PairList* inp = oldargs; inp; inp = inp->tail()) {
RObject* incar = inp->car();
if (incar == DotsSymbol) {
Frame::Binding* bdg = env->findBinding(CXXR::DotsSymbol);
if (!bdg)
Rf_error(_("'...' used but not bound"));
RObject* h = bdg->forcedValue();
if (!h || h->sexptype() == DOTSXP) {
ConsCell* dotlist = static_cast<DottedArgs*>(h);
while (dotlist) {
RObject* dotcar = dotlist->car();
RObject* outcar = Symbol::missingArgument();
if (m_first_arg_env) {
outcar = m_first_arg;
m_first_arg = 0;
m_first_arg_env = 0;
} else if (dotcar != Symbol::missingArgument())
outcar = Evaluator::evaluate(dotcar, env);
PairList* cell = PairList::cons(outcar, 0, dotlist->tag());
lastout = append(cell, lastout);
dotlist = dotlist->tail();
}
} else if (h != Symbol::missingArgument())
Rf_error(_("'...' used in an incorrect context"));
} else {
const RObject* tag = inp->tag();
PairList* cell = 0;
if (m_first_arg_env) {
cell = PairList::cons(m_first_arg, 0, tag);
m_first_arg = 0;
m_first_arg_env = 0;
} else if (incar && incar->sexptype() == SYMSXP) {
Symbol* sym = static_cast<Symbol*>(incar);
if (sym == Symbol::missingArgument()) {
if (allow_missing)
cell = PairList::cons(Symbol::missingArgument(), 0, tag);
else Rf_error(_("argument %d is empty"), arg_number);
} else if (isMissingArgument(sym, env->frame())) {
if (allow_missing)
cell = PairList::cons(Symbol::missingArgument(), 0, tag);
else Rf_error(_("'%s' is missing"),
sym->name()->c_str());
}
}
if (!cell) {
RObject* outcar = Evaluator::evaluate(incar, env);
cell = PairList::cons(outcar, 0, inp->tag());
}
lastout = append(cell, lastout);
}
++arg_number;
}
m_status = EVALUATED;
}
