private static SubstituteContext buildContext(Context context, SEXP evaluatedEnv) {
if (evaluatedEnv instanceof Environment) {
if (context.getGlobalEnvironment() == evaluatedEnv) {
return new GlobalEnvironmentContext();
} else {
return new EnvironmentContext((Environment) evaluatedEnv);
}
} else if (evaluatedEnv instanceof ListVector) {
return new ListContext((ListVector) evaluatedEnv);
} else if (evaluatedEnv instanceof PairList) {
return new PairListContext((PairList) evaluatedEnv);
} else {
throw new EvalException(
"Cannot substitute using environment of type %s: expected list, pairlist, or environment",
evaluatedEnv.getTypeName());
}
}
/* C version of the standardGeneric R function. */
public SEXP R_standardGeneric(Context context, Symbol fsym, Environment ev, SEXP fdef) {
String fname = fsym.getPrintName();
Environment f_env = context.getGlobalEnvironment().getBaseEnvironment();
SEXP mlist = Null.INSTANCE;
SEXP f;
SEXP val = Null.INSTANCE;
int nprotect = 0;
// if(!initialized)
// R_initMethodDispatch(NULL);
if (fdef instanceof Closure) {
f_env = ((Closure) fdef).getEnclosingEnvironment();
mlist = f_env.getVariable(".Methods");
if (mlist == Symbol.UNBOUND_VALUE) {
mlist = Null.INSTANCE;
}
} else if (fdef instanceof PrimitiveFunction) {
f_env = context.getBaseEnvironment();
// mlist = R_primitive_methods((PrimitiveFunction)fdef);
throw new UnsupportedOperationException();
} else {
throw new EvalException(
"invalid generic function object for method selection for function '%s': expected a function or a primitive, got an object of class \"%s\"",
fsym.getPrintName(), fdef.getAttributes().getClassVector());
}
if (mlist instanceof Null || mlist instanceof Closure || mlist instanceof PrimitiveFunction) {
f = mlist;
} else {
// f = do_dispatch(fname, ev, mlist, TRUE, TRUE);
throw new UnsupportedOperationException();
}
if (f == Null.INSTANCE) {
SEXP value =
R_S_MethodsListSelect(context, StringArrayVector.valueOf(fname), ev, mlist, f_env);
if (value == Null.INSTANCE) {
throw new EvalException(
"no direct or inherited method for function '%s' for this call", fname);
}
mlist = value;
/* now look again. This time the necessary method should
have been inserted in the MethodsList object */
f = do_dispatch(context, fname, (Environment) ev, mlist, false, true);
}
// /* loadMethod methods */
if (f.isObject()) {
f = R_loadMethod(context, f, fsym.getPrintName(), ev);
}
if (f instanceof Closure) {
return R_execMethod(context, (Closure) f, ev);
} else if (f instanceof PrimitiveFunction) {
/* primitives can't be methods; they arise only as the
default method when a primitive is made generic. In this
case, return a special marker telling the C code to go on
with the internal computations. */
// val = R_deferred_default_method();
throw new UnsupportedOperationException();
} else {
throw new EvalException("invalid object (non-function) used as method");
}
// return val;
}
