private SEXP do_dispatch(
Context context, String fname, SEXP ev, SEXP mlist, boolean firstTry, boolean evalArgs) {
String klass;
SEXP arg_slot;
Symbol arg_sym;
SEXP method, value = Null.INSTANCE;
int nprotect = 0;
/* check for dispatch turned off inside MethodsListSelect */
if (mlist instanceof Function) {
return mlist;
}
arg_slot = Methods.R_do_slot(context, mlist, s_argument);
if (arg_slot == Null.INSTANCE) {
throw new EvalException(
"object of class \"%s\" used as methods list for function '%s' "
+ "( no 'argument' slot)",
mlist.toString(), fname);
}
if (arg_slot instanceof Symbol) {
arg_sym = (Symbol) arg_slot;
} else {
/* shouldn't happen, since argument in class MethodsList has class
"name" */
arg_sym = Symbol.get(arg_slot.asString());
}
// if(arg_sym == Symbols.ELLIPSES || DDVAL(arg_sym) > 0)
// error(_("(in selecting a method for function '%s') '...' and related variables cannot be
// used for methods dispatch"),
// CHAR(asChar(fname)));
// if(TYPEOF(ev) != ENVSXP) {
// error(_("(in selecting a method for function '%s') the 'environment' argument for dispatch
// must be an R environment; got an object of class \"%s\""),
// CHAR(asChar(fname)), class_string(ev));
// return(R_NilValue); /* -Wall */
// }
/* find the symbol in the frame, but don't use eval, yet, because
missing arguments are ok & don't require defaults */
if (evalArgs) {
if (is_missing_arg(context, arg_sym, (Environment) ev)) {
klass = "missing";
} else {
/* get its class */
SEXP arg, class_obj;
try {
arg = context.evaluate(arg_sym, (Environment) ev);
} catch (EvalException e) {
throw new EvalException(
String.format(
"error in evaluating the argument '%s' in selecting a method for function '%s'",
arg_sym.getPrintName(), fname),
e);
}
class_obj = Methods.R_data_class(arg, true);
klass = class_obj.asString();
}
} else {
/* the arg contains the class as a string */
SEXP arg;
int check_err;
try {
arg = context.evaluate(arg_sym, (Environment) ev);
} catch (Exception e) {
throw new EvalException(
String.format(
"error in evaluating the argument '%s' in selecting a method for function '%s'",
arg_sym.getPrintName(), fname));
}
klass = arg.asString();
}
method = R_find_method(mlist, klass, fname);
if (method == Null.INSTANCE) {
if (!firstTry) {
throw new EvalException(
"no matching method for function '%s' (argument '%s', with class \"%s\")",
fname, arg_sym.getPrintName(), klass);
}
}
if (value == Symbol.MISSING_ARG) {
/* the check put in before calling
function MethodListSelect in R */
throw new EvalException(
"recursive use of function '%s' in method selection, with no default method", fname);
}
if (!(method instanceof Function)) {
/* assumes method is a methods list itself. */
/* call do_dispatch recursively. Note the NULL for fname; this is
passed on to the S language search function for inherited
methods, to indicate a recursive call, not one to be stored in
the methods metadata */
method = do_dispatch(context, null, ev, method, firstTry, evalArgs);
}
return method;
}
