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);
}
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 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;
}
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;
}
