static void overrideDebuggerPrimitives()

in src/debugger/RDebugger.cpp [690:788]
87 lines of code
22 McCabe index (conditional complexity)

static void overrideDebuggerPrimitives() {
  static PrSEXP browserText = toSEXP("");
  static PrSEXP browserCondition = R_NilValue;

  setFunTabFunction(getFunTabOffset("browser"), [](SEXP call, SEXP op, SEXP args, SEXP env) {
    if (!rDebugger.isEnabled()) return R_NilValue;
    SEXP ap, argList;

    /* argument matching */
    PROTECT(ap = list4(R_NilValue, R_NilValue, R_NilValue, R_NilValue));
    SET_TAG(ap,  install("text"));
    SET_TAG(CDR(ap), install("condition"));
    SET_TAG(CDDR(ap), install("expr"));
    SET_TAG(CDDDR(ap), install("skipCalls"));
    argList = matchArgs(ap, args, call);
    UNPROTECT(1);
    PROTECT(argList);
    /* substitute defaults */
    if(CAR(argList) == R_MissingArg) SETCAR(argList, mkString(""));
    if(CADR(argList) == R_MissingArg) SETCAR(CDR(argList), R_NilValue);
    if(CADDR(argList) == R_MissingArg) SETCAR(CDDR(argList), ScalarLogical(1));
    if(CADDDR(argList) == R_MissingArg) SETCAR(CDDDR(argList), ScalarInteger(0));

    if (asLogical(CADDR(argList))) {
      CPP_BEGIN
        ScopedAssign<PrSEXP> withBrowserText(browserText, CAR(argList));
        ScopedAssign<PrSEXP> withBrowserCondition(browserCondition, CADR(argList));
        rDebugger.sendDebugPrompt(call);
      CPP_END_VOID
    }
    UNPROTECT(1);
    return R_NilValue;
  });

  setFunTabFunction(getFunTabOffset("browserText"), [](SEXP, SEXP, SEXP, SEXP) { return (SEXP)browserText; });
  setFunTabFunction(getFunTabOffset("browserCondition"), [](SEXP, SEXP, SEXP, SEXP) { return (SEXP)browserCondition; });
  setFunTabFunction(getFunTabOffset("browserSetDebug"), [](SEXP, SEXP, SEXP, SEXP) { return R_NilValue; });

  auto myDoDebug = [](SEXP call, SEXP op, SEXP args, SEXP rho) {
    SEXP ans = R_NilValue;

    Rf_checkArityCall(op, args, call);
    if (Rf_isValidString(CAR(args))) {
      SEXP s = Rf_installTrChar(STRING_ELT(CAR(args), 0));
      PROTECT(s);
      SETCAR(args, Rf_findFun(s, rho));
      UNPROTECT(1);
    }

    SEXP fun = CAR(args);
    if (TYPEOF(fun) == SPECIALSXP || TYPEOF(fun) == BUILTINSXP) {
      return getPrimVal(op) == 2 ? Rf_ScalarLogical(false) : R_NilValue;
    }
    if (TYPEOF(fun) != CLOSXP) {
      Rf_error("argument must be a function");
    }

    PROTECT(fun);
    SEXP body = BODY_EXPR(fun);
    bool isBlock = TYPEOF(body) == LANGSXP && CAR(body) == RI->beginSymbol;
    switch (getPrimVal(op)) {
    case 0: // debug()
      if (!isBlock) {
        body = generateBlockBody(fun);
      } else {
        SET_BODY(fun, body = Rf_shallow_duplicate(body));
      }
      Rf_setAttrib(body, RI->functionDebugFlag, Rf_ScalarLogical(true));
      break;
    case 1: // undebug()
      if (isBlock && Rf_getAttrib(body, RI->functionDebugFlag) != R_NilValue) {
        Rf_setAttrib(body, RI->functionDebugFlag, R_NilValue);
        removeBlockBodyIfNotNeeded(fun);
      } else {
        Rf_warning("argument is not being debugged");
      }
      break;
    case 2: // isdebugged()
      ans = Rf_ScalarLogical(isBlock && Rf_getAttrib(body, RI->functionDebugFlag) != R_NilValue);
      break;
    case 3: // debugonce()
      if (!isBlock) {
        body = generateBlockBody(fun);
      } else {
        SET_BODY(fun, body = Rf_shallow_duplicate(body));
      }
      Rf_setAttrib(body, RI->functionDebugOnceFlag, Rf_ScalarLogical(true));
      break;
    }

    UNPROTECT(1);
    return ans;
  };

  setFunTabFunction(getFunTabOffset("debug"), myDoDebug);
  setFunTabFunction(getFunTabOffset("undebug"), myDoDebug);
  setFunTabFunction(getFunTabOffset("isdebugged"), myDoDebug);
  setFunTabFunction(getFunTabOffset("debugonce"), myDoDebug);
}