/* The $ subset operator.
We need to be sure to only evaluate the first argument.
The second will be a symbol that needs to be matched, not evaluated.
*/
SEXP attribute_hidden do_subset3(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP input, nlist, ans;
checkArity(op, args);
/* first translate CADR of args into a string so that we can
pass it down to DispatchorEval and have it behave correctly */
input = PROTECT(allocVector(STRSXP, 1));
nlist = CADR(args);
if (TYPEOF(nlist) == PROMSXP)
nlist = eval(nlist, env);
if(isSymbol(nlist) )
SET_STRING_ELT(input, 0, PRINTNAME(nlist));
else if(isString(nlist) )
SET_STRING_ELT(input, 0, STRING_ELT(nlist, 0));
else {
errorcall(call,_("invalid subscript type '%s'"),
type2char(TYPEOF(nlist)));
}
/* replace the second argument with a string */
/* Previously this was SETCADR(args, input); */
/* which could cause problems when nlist was */
/* ..., as in PR#8718 */
PROTECT(args = CONS(CAR(args), CONS(input, R_NilValue)));
/* If the first argument is an object and there is */
/* an approriate method, we dispatch to that method, */
/* otherwise we evaluate the arguments and fall */
/* through to the generic code below. Note that */
/* evaluation retains any missing argument indicators. */
if(R_DispatchOrEvalSP(call, op, "$", args, env, &ans)) {
UNPROTECT(2); /* input, args */
if (NAMED(ans))
SET_NAMED(ans, 2);
return(ans);
}
UNPROTECT(2); /* input, args */
return R_subset3_dflt(CAR(ans), STRING_ELT(input, 0), call);
}
SEXP attribute_hidden do_subset2(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP ans;
/* If the first argument is an object and there is */
/* an approriate method, we dispatch to that method, */
/* otherwise we evaluate the arguments and fall */
/* through to the generic code below. Note that */
/* evaluation retains any missing argument indicators. */
if(R_DispatchOrEvalSP(call, op, "[[", args, rho, &ans)) {
if (NAMED(ans))
SET_NAMED(ans, 2);
return(ans);
}
/* Method dispatch has failed. */
/* We now run the generic internal code. */
return do_subset2_dflt(call, op, ans, rho);
}
