/* & | ! */ 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 */ } }