private static SEXP R_loadMethod(Context context, SEXP def, String fname, Environment ev) {
/* since this is called every time a method is dispatched with a
definition that has a class, it should be as efficient as
possible => we build in knowledge of the standard
MethodDefinition and MethodWithNext slots. If these (+ the
class slot) don't account for all the attributes, regular
dispatch is done. */
int found = 1; /* we "know" the class attribute is there */
found++; // we also have our fake __S4_BIt for renjin
PairList attrib = def.getAttributes().asPairList();
for (PairList.Node s : attrib.nodes()) {
SEXP t = s.getTag();
if (t == R_target) {
ev.setVariable(R_dot_target, s.getValue());
found++;
} else if (t == R_defined) {
ev.setVariable(R_dot_defined, s.getValue());
found++;
} else if (t == R_nextMethod) {
ev.setVariable(R_dot_nextMethod, s.getValue());
found++;
} else if (t == Symbols.SOURCE) {
/* ignore */ found++;
}
}
ev.setVariable(R_dot_Method, def);
/* this shouldn't be needed but check the generic being
"loadMethod", which would produce a recursive loop */
if (fname.equals("loadMethod")) {
return def;
}
if (found < attrib.length()) {
FunctionCall call =
FunctionCall.newCall(R_loadMethod_name, def, StringArrayVector.valueOf(fname), ev);
return context.evaluate(call, ev);
// SEXP e, val;
// PROTECT(e = allocVector(LANGSXP, 4));
// SETCAR(e, R_loadMethod_name); val = CDR(e);
// SETCAR(val, def); val = CDR(val);
// SETCAR(val, fname); val = CDR(val);
// SETCAR(val, ev);
// val = eval(e, ev);
// return val;
} else {
return def;
}
}
public static SEXP R_execMethod(Context context, Closure op, Environment rho) {
/* create a new environment frame enclosed by the lexical
environment of the method */
Environment newrho = Environment.createChildEnvironment(op.getEnclosingEnvironment());
/* copy the bindings for the formal environment from the top frame
of the internal environment of the generic call to the new
frame. need to make sure missingness information is preserved
and the environments for any default expression promises are
set to the new environment. should move this to envir.c where
it can be done more efficiently. */
for (PairList.Node next : op.getFormals().nodes()) {
// R_varloc_t loc;
// int missing;
// TODO(alex): redo missingness handling
// loc = R_findVarLocInFrame(rho,symbol);
// if(loc == NULL)
// throw new EvalException("could not find symbol \"%s\" in environment of the generic
// function"),
// CHAR(PRINTNAME(symbol)));
// missing = R_GetVarLocMISSING(loc);
// val = R_GetVarLocValue(loc);
if (!next.hasTag()) {
throw new EvalException("closure formal has no tag! op = " + op);
}
Symbol symbol = next.getTag();
SEXP val = rho.findVariable(symbol);
if (val == Symbol.UNBOUND_VALUE) {
throw new EvalException(
"could not find symbol \"%s\" in the environment of the generic function",
symbol.getPrintName());
}
// SET_FRAME(newrho, CONS(val, FRAME(newrho)));
// SET_TAG(FRAME(newrho), symbol);
newrho.setVariable(symbol, val);
// if (missing) {
// SET_MISSING(FRAME(newrho), missing);
// if (TYPEOF(val) == PROMSXP && PRENV(val) == rho) {
// SEXP deflt;
// SET_PRENV(val, newrho);
// /* find the symbol in the method, copy its expression
// * to the promise */
// for(deflt = CAR(op); deflt != R_NilValue; deflt = CDR(deflt)) {
// if(TAG(deflt) == symbol)
// break;
// }
// if(deflt == R_NilValue)
// error(_("symbol \"%s\" not in environment of method"),
// CHAR(PRINTNAME(symbol)));
// SET_PRCODE(val, CAR(deflt));
// }
// }
}
/* copy the bindings of the spacial dispatch variables in the top
frame of the generic call to the new frame */
newrho.setVariable(DOT_DEFINED, rho.getVariable(DOT_DEFINED));
newrho.setVariable(DOT_METHOD, rho.getVariable(DOT_METHOD));
newrho.setVariable(DOT_TARGET, rho.getVariable(DOT_TARGET));
/* copy the bindings for .Generic and .Methods. We know (I think)
that they are in the second frame, so we could use that. */
newrho.setVariable(Symbols.GENERIC, newrho.getVariable(".Generic"));
newrho.setVariable(DOT_METHODS, newrho.getVariable(DOT_METHODS));
/* Find the calling context. Should be R_GlobalContext unless
profiling has inserted a CTXT_BUILTIN frame. */
Context cptr = context;
// cptr = R_GlobalContext;
// if (cptr->callflag & CTXT_BUILTIN)
// cptr = cptr->nextcontext;
/* The calling environment should either be the environment of the
generic, rho, or the environment of the caller of the generic,
the current sysparent. */
Environment callerenv = cptr.getCallingEnvironment(); /* or rho? */
/* get the rest of the stuff we need from the current context,
execute the method, and return the result */
FunctionCall call = cptr.getCall();
PairList arglist = cptr.getArguments();
SEXP val = R_execClosure(context, call, op, arglist, callerenv, newrho);
return val;
}