SEXP R_mpc_div(SEXP e1, SEXP e2) {
/* N.B. We always use signed integers for e2 given R's type system. */
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, max(mpc_get_prec(*z1),
mpc_get_prec(*z2)));
mpc_div(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_div_ui(*z, *z1, INTEGER(e2)[0],
Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
mpc_div_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else if (Rf_isInteger(e1)) {
if (Rf_inherits(e2, "mpc")) {
/* TODO: sign issue here. mpc_ui_div is
* unsigned, mult -1 if needed by asnwer? */
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, mpc_get_prec(*z2));
mpc_ui_div(*z, INTEGER(e1)[0], *z2,
Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else if (Rf_isNumeric(e1)) {
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
mpc_fr_div(*z, x, *z2, Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc division.");
}
} else {
Rf_error("Invalid operands for mpc division.");
}
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;
}
mpcomplex operator/(const long int& a, const mpcomplex& b) {
mpc_t value;
mpc_init3( value , b.mpc_prec, b.mpc_prec );
mpc_ui_div(value, a, b.mpc_val, b.mpc_rnd);
return mpcomplex(value);
}
