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