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); }
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); }
/** @brief Get or create a Binding for a Symbol. * * If the Frame already contains a Binding for a specified * Symbol, the function returns it. Otherwise a Binding to * the null pointer is created, and a pointer to that Binding * returned. * * An error is raised if a new Binding needs to be created and * the Frame is locked. * * @param symbol The Symbol for which a Binding is to be * obtained. * @param location assigned to the Symbol in the FrameDescriptor. * * @return Pointer to the required Binding. */ Binding* obtainBinding(const Symbol* symbol, int location) { Frame::Binding* binding = m_bindings + location; if (!binding->isSet()) { initializeBindingIfUnlocked(binding, symbol); m_used_bindings_size = std::max(m_used_bindings_size, (unsigned char)(location + 1)); } return binding; }
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; }
/* * Assign to a symbol in a CompiledFrame. */ void rho_runtime_assignSymbolInCompiledFrame(const Symbol* symbol, Environment* environment, int position, RObject* value) { assert(environment->frame() != nullptr); assert(value != R_MissingArg); assert(position >= 0); Frame* frame = environment->frame(); assert(frame != nullptr); Frame::Binding* binding = frame->obtainBinding(symbol, position); binding->assign(value); }
int main(int argc, char* argv[]) { Evaluator evalr; if (argc < 3 || argc > 4) usage(argv[0]); // Set up error reporting: ptr_R_WriteConsoleEx = WriteConsoleEx; ptr_R_ResetConsole = ptr_R_FlushConsole = ptr_R_ClearerrConsole = DoNothing; Rf_InitOptions(); // Set up Environments: GCStackRoot<Frame> ff(CXXR_NEW(ListFrame)); GCStackRoot<Environment> fenvrt(CXXR_NEW(Environment(0, ff))); fenv = fenvrt; // Process formals: cout << "Formal arguments:\n\n"; GCStackRoot<PairList> formals(getArgs(argv[1])); GCStackRoot<ArgMatcher> matcher; try { matcher = GCNode::expose(new ArgMatcher(formals)); } catch (CommandTerminated) { cerr << "ArgMatchertest: Error encountered while processing formals" << endl; return 0; } // Process supplied arguments: cout << "\nSupplied arguments:\n\n"; ArgList supplied(getArgs(argv[2]), ArgList::RAW); // Set up frame and prior bindings (if any): Frame* frame = fenv->frame(); if (argc == 4) { cout << "\nPrior bindings:\n\n"; GCStackRoot<PairList> prior_bindings(getArgs(argv[3])); for (PairList* pb = prior_bindings; pb; pb = pb->tail()) { const Symbol* tag = static_cast<const Symbol*>(pb->tag()); Frame::Binding* bdg = frame->obtainBinding(tag); bdg->setValue(pb->car(), Frame::Binding::EXPLICIT); } } // Perform match and show result: try { matcher->match(fenv, &supplied); } catch (CommandTerminated) { cerr << "ArgMatchertest: Error encountered while matching arguments" << endl; return 0; } cout << "\nMatch result:\n\n"; showFrame(frame); return 0; }
/* * Assign to a symbol in a CompiledFrame. */ void cxxr_runtime_assignSymbolInCompiledFrame(const Symbol* symbol, Environment* environment, int position, RObject* value) { assert(environment->frame() != nullptr); assert(value != R_MissingArg); assert(position >= 0); JIT::CompiledFrame* frame // TODO(kmillar): when optimizing make this a static cast. = dynamic_cast<JIT::CompiledFrame*>(environment->frame()); assert(frame != nullptr); Frame::Binding* binding = frame->obtainBinding(symbol, position); binding->assign(value); }
SEXP attribute_hidden do_provCommand (SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'provCommand' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("provCommand expects Symbol argument")); Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); return const_cast<RObject*>(bdg->provenance()->command()); #endif // PROVENANCE_TRACKING }
SEXP attribute_hidden do_hasProvenance (SEXP call, SEXP op, SEXP args, SEXP rho) { int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'hasProvenance' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("hasProvenance expects Symbol argument")); GCStackRoot<LogicalVector> v(GCNode::expose(new LogicalVector(1))); #ifdef PROVENANCE_TRACKING Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); (*v)[0] = (bdg->provenance() != 0); #else (*v)[0] = false; #endif return v; }
/* * Lookup a symbol in a CompiledFrame. * Note that this function doesn't handle the cases where the symbol is * ..., ..n, or missingArg(). cxxr_runtime_lookupSymbol should be used in * those cases. */ RObject* cxxr_runtime_lookupSymbolInCompiledFrame(const Symbol* symbol, Environment* environment, int position) { assert(environment->frame() != nullptr); assert(symbol != DotsSymbol); assert(!symbol->isDotDotSymbol()); assert(symbol != R_MissingArg); assert(position >= 0); JIT::CompiledFrame* frame // TODO(kmillar): when optimizing make this a static cast. = dynamic_cast<JIT::CompiledFrame*>(environment->frame()); assert(frame != nullptr); Frame::Binding* binding = frame->binding(position); if (binding) { // NB: this logic handles the case where the binding is a promise that // resolves to an unboundValue or missingArgument slightly differently // than Symbol::evaluate() does. std::pair<RObject*, bool> pair = binding->forcedValue2(); RObject* value = pair.first; if (value && value != Symbol::missingArgument() && value != Symbol::unboundValue()) { if (pair.second) { SET_NAMED(value, 2); } else if (NAMED(value) < 1) { SET_NAMED(value, 1); } return value; } } // Fallback to the interpreter. return cxxr_runtime_lookupSymbol(symbol, environment); }
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; }
SEXP attribute_hidden do_provenance_graph(SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else int nargs = length(args); if (nargs != 1) Rf_error(_("%d arguments passed to 'provenance.graph' which requires 1"), nargs); SEXP arg1 = CAR(args); if (!arg1 || arg1->sexptype() != STRSXP) Rf_error(_("invalid 'names' argument")); Environment* env = static_cast<Environment*>(rho); Provenance::Set provs; StringVector* sv = static_cast<StringVector*>(arg1); for (size_t i = 0; i < sv->size(); i++) { const char* name = (*sv)[i]->c_str(); Symbol* sym = Symbol::obtain(name); Frame::Binding* bdg = env->findBinding(sym); if (!bdg) Rf_error(_("symbol '%s' not found"), name); else { Provenance* prov = const_cast<Provenance*>(bdg->provenance()); if (!prov) Rf_warning(_("'%s' does not have provenance information"), name); else provs.insert(prov); } } Provenance::Set* ancestors = Provenance::ancestors(provs); GCStackRoot<ListVector> ans(CXXR_NEW(ListVector(7))); std::map<const Provenance*, unsigned int> ancestor_index; std::vector<std::pair<unsigned int, const RObject*> > xenogenous_bdgs; // Assemble information on graph nodes: { size_t n = ancestors->size(); GCStackRoot<ListVector> symbols(CXXR_NEW(ListVector(n))); GCStackRoot<ListVector> commands(CXXR_NEW(ListVector(n))); GCStackRoot<RealVector> timestamps(CXXR_NEW(RealVector(n))); size_t i = 0; for (Provenance::Set::iterator it = ancestors->begin(); it != ancestors->end(); ++it) { const Provenance* p = *it; (*symbols)[i] = const_cast<Symbol*>(p->symbol()); (*commands)[i] = const_cast<RObject*>(p->command()); (*timestamps)[i] = p->timestamp(); ++i; ancestor_index[p] = i; if (p->isXenogenous()) xenogenous_bdgs.push_back(std::make_pair(i, p->value())); } (*ans)[0] = symbols; (*ans)[1] = commands; (*ans)[2] = timestamps; } // Record information on xenogenous bindings: { size_t xn = xenogenous_bdgs.size(); GCStackRoot<IntVector> xenogenous(CXXR_NEW(IntVector(xn))); GCStackRoot<ListVector> values(CXXR_NEW(ListVector(xn))); for (unsigned int i = 0; i < xn; ++i) { std::pair<unsigned int, const RObject*>& pr = xenogenous_bdgs[i]; (*xenogenous)[i] = pr.first; (*values)[i] = const_cast<RObject*>(pr.second); } (*ans)[3] = xenogenous; (*ans)[4] = values; } // Assemble information on graph edges: { typedef std::set<std::pair<unsigned int, unsigned int> > EdgeSet; EdgeSet edges; for (Provenance::Set::iterator it = ancestors->begin(); it != ancestors->end(); ++it) { const Provenance* child = *it; unsigned int child_idx = ancestor_index[child]; std::pair<CommandChronicle::ParentVector::const_iterator, CommandChronicle::ParentVector::const_iterator> pr = child->parents(); for (CommandChronicle::ParentVector::const_iterator it = pr.first; it != pr.second; ++it) { const Provenance* parent = *it; unsigned int parent_idx = ancestor_index[parent]; edges.insert(std::make_pair(parent_idx, child_idx)); } } size_t en = edges.size(); GCStackRoot<IntVector> parents(CXXR_NEW(IntVector(en))); GCStackRoot<IntVector> children(CXXR_NEW(IntVector(en))); unsigned int i = 0; for (EdgeSet::const_iterator it = edges.begin(); it != edges.end(); ++it) { const std::pair<unsigned int, unsigned int>& edge = *it; (*parents)[i] = edge.first; (*children)[i] = edge.second; ++i; } (*ans)[5] = parents; (*ans)[6] = children; } delete ancestors; return ans; #endif // PROVENANCE_TRACKING }
SEXP attribute_hidden do_provenance (SEXP call, SEXP op, SEXP args, SEXP rho) { #ifndef PROVENANCE_TRACKING Rf_error(_("provenance tracking not implemented in this build")); return 0; #else const int nfields=5; int n; if ((n=length(args))!=1) errorcall(call,_("%d arguments passed to 'provenance' which requires 1"),n); if (TYPEOF(CAR(args))!=SYMSXP) errorcall(call,_("provenance expects Symbol argument")); Symbol* sym=SEXP_downcast<Symbol*>(CAR(args)); Environment* env=static_cast<Environment*>(rho); Frame::Binding* bdg = env->findBinding(sym); if (!bdg) errorcall(call,_("invalid Symbol passed to 'provenance'")); Provenance* provenance=const_cast<Provenance*>(bdg->provenance()); if (!provenance) errorcall(call,_("object does not have any provenance")); const Provenance::Set& children=provenance->children(); GCStackRoot<ListVector> list(GCNode::expose(new ListVector(nfields))); GCStackRoot<StringVector> timestamp(GCNode::expose(new StringVector(1))); GCStackRoot<StringVector> names(GCNode::expose(new StringVector(nfields))); (*timestamp)[0]=const_cast<String*>(provenance->getTime()); (*names)[0]=const_cast<String*>(String::obtain("command")); (*names)[1]=const_cast<String*>(String::obtain("symbol")); (*names)[2]=const_cast<String*>(String::obtain("timestamp")); (*names)[3]=const_cast<String*>(String::obtain("parents")); (*names)[4]=const_cast<String*>(String::obtain("children")); (*list)[0] = const_cast<RObject*>(provenance->command()); (*list)[1] = const_cast<Symbol*>(provenance->symbol()); (*list)[2]=timestamp; // Handle parents: { std::pair<CommandChronicle::ParentVector::const_iterator, CommandChronicle::ParentVector::const_iterator> pr = provenance->parents(); size_t sz = pr.second - pr.first; StringVector* sv = CXXR_NEW(StringVector(sz)); (*list)[3] = sv; unsigned int i = 0; for (CommandChronicle::ParentVector::const_iterator it = pr.first; it != pr.second; ++it) { const Provenance* p = *it; (*sv)[i++] = const_cast<String*>(p->symbol()->name()); } } if (!children.empty()) { StringVector* sv = CXXR_NEW(StringVector(children.size())); (*list)[4] = sv; unsigned int i = 0; for (Provenance::Set::const_iterator it = children.begin(); it != children.end(); ++it) { const Provenance* p = *it; (*sv)[i++] = const_cast<String*>(p->symbol()->name()); } } setAttrib(list,R_NamesSymbol,names); return list; #endif // PROVENANCE_TRACKING }