Ejemplo n.º 1
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);
}
Ejemplo n.º 2
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);
}
Ejemplo n.º 3
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;
}
Ejemplo n.º 4
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;
}