shithub: sl

ref: fb908fbd038ae14d54738ab146495bb962a5ec47
dir: /src/sl_arith_any.h/

//sl_v
//sl_*_any(sl_v *args, u32int 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;
	s64int Saccum = ACCUM_DEFAULT, x;
	u64int u64;
	double Faccum = ACCUM_DEFAULT;
	bool inexact = false;
	sl_v arg;
	sl_numtype pt;
	void *a;
	sl_cprim *cp;
	csl_v *cv;

	u32int 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_S8:  x = *(s8int*)a; break;
			case T_U8:  x = *(u8int*)a; break;
			case T_S16: x = *(s16int*)a; break;
			case T_U16: x = *(u16int*)a; break;
			case T_S32: x = *(s32int*)a; break;
			case T_U32: x = *(u32int*)a; break;
			case T_S64: x = *(s64int*)a; break;
			case T_U64:
				u64 = *(u64int*)a;
				if(u64 > INT64_MAX){
					x = ACCUM_DEFAULT;
					goto overflow;
				}
				x = u64;
				break;
			case T_MP:
				x = ACCUM_DEFAULT;
				u64 = ACCUM_DEFAULT;
				m = mpcopy(*(mpint**)a);
				goto overflow;
			default:
				goto typeerr;
			}
		}

		s64int 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((sl_fx)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_S8:  x = *(s8int*)a; break;
		case T_U8:  x = *(u8int*)a; break;
		case T_S16: x = *(s16int*)a; break;
		case T_U16: x = *(u16int*)a; break;
		case T_S32: x = *(s32int*)a; break;
		case T_U32: x = *(u32int*)a; break;
		case T_S64: x = *(s64int*)a; break;
		case T_U64:
			uvtomp(*(u64int*)a, m);
			MP_OP(Maccum, m, Maccum);
			continue;
		case T_MP:
			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_mp(Maccum);
	}

down:
	mpfree(m);
	Saccum = mptov(Maccum);
	mpfree(Maccum);
	if(inexact)
		return mk_double(ARITH_OP(Faccum, Saccum));
	assert(fits_fixnum(Saccum));
	return fixnum((sl_fx)Saccum);

#undef ACCUM_DEFAULT
#undef ARITH_OP
#undef MP_OP
#undef ARITH_OVERFLOW