ref: 14c196a5da48284123d615418c80b6fbc87d7f46
dir: /fl_arith_any.inc/
//value_t //fl_*_any(value_t *args, uint32_t nargs) // input: ACCUM_DEFAULT ARITH_OP(a,b) MP_OP ARITH_OVERFLOW // add: 0 a+b mpadd sadd_overflow_64 // mul: 1 a*b mpmul smul_overflow_64 mpint *Maccum = nil, *m = nil; int64_t Saccum = ACCUM_DEFAULT, x; uint64_t u64; double Faccum = ACCUM_DEFAULT; bool inexact = false; value_t arg; numerictype_t pt; void *a; cprim_t *cp; cvalue_t *cv; uint32_t i, j; FOR_ARGS(i, 0, arg, args){ if(isfixnum(arg)) x = numval(arg); else{ if(iscprim(arg)){ cp = ptr(arg); a = cp_data(cp); pt = cp_numtype(cp); }else if(iscvalue(arg)){ cv = ptr(arg); a = cv_data(cv); pt = cv_class(cv)->numtype; }else{ typeerr: mpfree(Maccum); mpfree(m); type_error("number", arg); } switch(pt){ case T_DOUBLE: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue; case T_FLOAT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue; case T_INT8: x = *(int8_t*)a; break; case T_UINT8: x = *(uint8_t*)a; break; case T_INT16: x = *(int16_t*)a; break; case T_UINT16: x = *(uint16_t*)a; break; case T_INT32: x = *(int32_t*)a; break; case T_UINT32: x = *(uint32_t*)a; break; case T_INT64: x = *(int64_t*)a; break; case T_UINT64: u64 = *(uint64_t*)a; if(u64 > INT64_MAX){ x = ACCUM_DEFAULT; goto overflow; } x = u64; break; case T_MPINT: x = ACCUM_DEFAULT; u64 = ACCUM_DEFAULT; m = mpcopy(*(mpint**)a); goto overflow; default: goto typeerr; } } int64_t accu; if(ARITH_OVERFLOW(Saccum, x, &accu)){ u64 = ACCUM_DEFAULT; goto overflow; } Saccum = accu; } if(inexact) return mk_double(ARITH_OP(Faccum, Saccum)); if(fits_fixnum(Saccum)) return fixnum((fixnum_t)Saccum); u64 = ACCUM_DEFAULT; x = ACCUM_DEFAULT; overflow: i++; if(Maccum == nil) Maccum = vtomp(Saccum, nil); if(m == nil) m = u64 != ACCUM_DEFAULT ? uvtomp(u64, nil) : vtomp(x, nil); MP_OP(Maccum, m, Maccum); FOR_ARGS(j, i, arg, args){ if(isfixnum(arg)){ vtomp(numval(arg), m); MP_OP(Maccum, m, Maccum); continue; } if(iscprim(arg)){ cp = ptr(arg); a = cp_data(cp); pt = cp_numtype(cp); }else if(iscvalue(arg)){ cv = ptr(arg); a = cv_data(cv); pt = cv_class(cv)->numtype; }else{ goto typeerr; } switch(pt){ case T_DOUBLE: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue; case T_FLOAT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue; case T_INT8: x = *(int8_t*)a; break; case T_UINT8: x = *(uint8_t*)a; break; case T_INT16: x = *(int16_t*)a; break; case T_UINT16: x = *(uint16_t*)a; break; case T_INT32: x = *(int32_t*)a; break; case T_UINT32: x = *(uint32_t*)a; break; case T_INT64: x = *(int64_t*)a; break; case T_UINT64: uvtomp(*(uint64_t*)a, m); MP_OP(Maccum, m, Maccum); continue; case T_MPINT: MP_OP(Maccum, *(mpint**)a, Maccum); continue; default: goto typeerr; } vtomp(x, m); MP_OP(Maccum, m, Maccum); } int n = mpsignif(Maccum); if(n >= FIXNUM_BITS){ if(inexact){ dtomp(Faccum, m); MP_OP(Maccum, m, Maccum); n = mpsignif(Maccum); if(n < FIXNUM_BITS){ inexact = false; goto down; } } mpfree(m); return mk_mpint(Maccum); } down: mpfree(m); Saccum = mptov(Maccum); mpfree(Maccum); if(inexact) return mk_double(ARITH_OP(Faccum, Saccum)); assert(fits_fixnum(Saccum)); return fixnum((fixnum_t)Saccum); #undef ACCUM_DEFAULT #undef ARITH_OP #undef MP_OP #undef ARITH_OVERFLOW