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