static void
check_ternary_value (mpfr_prec_t prec_max, mpfr_prec_t step)
{
mpfr_prec_t prec;
mpc_t z;
mpfr_t f;
mpc_init2 (z, 2);
mpfr_init (f);
for (prec = 2; prec < prec_max; prec += step)
{
mpc_set_prec (z, prec);
mpfr_set_prec (f, prec);
mpc_set_ui (z, 1, MPC_RNDNN);
mpfr_set_ui (f, 1, MPFR_RNDN);
if (mpc_add_fr (z, z, f, MPC_RNDNZ))
{
printf ("Error in mpc_add_fr: 1+1 should be exact\n");
exit (1);
}
mpc_set_ui (z, 1, MPC_RNDNN);
mpc_mul_2ui (z, z, (unsigned long int) prec, MPC_RNDNN);
if (mpc_add_fr (z, z, f, MPC_RNDNN) == 0)
{
fprintf (stderr, "Error in mpc_add_fr: 2^prec+1 cannot be exact\n");
exit (1);
}
}
mpc_clear (z);
mpfr_clear (f);
}
SEXP R_mpc_add(SEXP e1, SEXP e2) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (z == NULL) {
Rf_error("Could not allocate memory for MPC type.");
}
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpfr_prec_t real_prec, imag_prec;
Rmpc_get_max_prec(&real_prec, &imag_prec, *z1, *z2);
mpc_init3(*z, real_prec, imag_prec);
mpc_add(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_add_ui(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpfr_t x;
mpfr_init2(x, 53);
// We use GMP_RNDN rather than MPFR_RNDN for compatibility
// with mpfr 2.4.x and earlier as well as more modern versions.
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
/* Max of mpc precision z2 and 53 from e2. */
Rprintf("Precision: %d\n", mpc_get_prec(*z1));
mpc_init2(*z, max(mpc_get_prec(*z1), 53));
mpc_add_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
/* TODO(mstokely): Add support for mpfr types here. */
free(z);
Rf_error("Invalid second operand for mpc addition.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
