/* & | ! */
SEXP attribute_hidden do_logic(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP arg1 = CAR(args); //, arg2 = CADR(args)
Rboolean attr1 = ATTRIB(arg1) != R_NilValue;
if (attr1 || ATTRIB(CADR(args)) != R_NilValue) {
SEXP ans;
if (DispatchGroup("Ops", call, op, args, env, &ans))
return ans;
}
/* The above did dispatch to valid S3/S4 methods, including those with
* "wrong" number of arguments.
* Now require binary calls to `&` and `|` or unary calls to `!` : */
checkArity(op, args);
if (CDR(args) == R_NilValue) { // one argument <==> !(arg1)
if (!attr1 && IS_SCALAR(arg1, LGLSXP)) {
/* directly handle '!' operator for simple logical scalars. */
int v = LOGICAL(arg1)[0];
return ScalarLogical(v == NA_LOGICAL ? v : ! v);
}
return lunary(call, op, arg1);
}
// else : two arguments
return lbinary(call, op, args);
}
/* & | ! */
SEXP attribute_hidden do_logic(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP ans, arg1, arg2;
int argc;
if (args == R_NilValue)
argc = 0;
else if (CDR(args) == R_NilValue)
argc = 1;
else if (CDDR(args) == R_NilValue)
argc = 2;
else
argc = length(args);
arg1 = CAR(args);
arg2 = CADR(args);
if (ATTRIB(arg1) != R_NilValue || ATTRIB(arg2) != R_NilValue) {
if (DispatchGroup("Ops",call, op, args, env, &ans))
return ans;
}
else if (argc == 1 && IS_SCALAR(arg1, LGLSXP)) {
/* directly handle '!' operator for simple logical scalars. */
int v = LOGICAL(arg1)[0];
return ScalarLogical(v == NA_LOGICAL ? v : ! v);
}
if (argc == 1)
return lunary(call, op, arg1);
else if (argc == 2)
return lbinary(call, op, args);
else
error(_("binary operations require two arguments"));
return R_NilValue; /* for -Wall */
}
/* & | ! */
SEXP attribute_hidden do_logic(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP ans;
if (DispatchGroup("Ops",call, op, args, env, &ans))
return ans;
switch (length(args)) {
case 1:
return lunary(call, op, CAR(args));
case 2:
return lbinary(call, op, args);
default:
error(_("binary operations require two arguments"));
return R_NilValue; /* for -Wall */
}
}
