Пример #1
0
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);
}
Пример #2
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);
}
Пример #3
0
	/** @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;
	}
Пример #4
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;
}
Пример #5
0
/*
 * 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);
}
Пример #6
0
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;
}
Пример #7
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);
}
Пример #8
0
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
}
Пример #9
0
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;
}
Пример #10
0
/*
 * 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);
}
Пример #11
0
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;
}
Пример #12
0
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
}
Пример #13
0
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
}