diff --git a/C/absmi.c b/C/absmi.c index 95fc005d5..bf533f71a 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -509,44 +509,6 @@ Term Yap_XREGS[MaxTemps]; /* 29 */ #endif -inline static Functor -AritFunctorOfTerm(Term t) { - if (IsVarTerm(t)) { - return(FunctorDBRef); - } - if (IsApplTerm(t)) { - return(FunctorOfTerm(t)); - } else { - if (IsIntTerm(t)) - return(FunctorLongInt); - else - return(FunctorDBRef); - } -} - -#define TMP_BIG() Yap_BigTmp -#define RINT(v) return(MkIntegerTerm(v)) -#define RFLOAT(v) return(MkFloatTerm(v)) -#if USE_GMP - -#define RBIG(v) return(rbig(v)) - -static inline Term rbig(MP_INT *big) -{ - Term t = Yap_MkBigIntTerm(big); - mpz_clear(big); - return t; -} -#endif - -#define RERROR() return(TermNil) - -#define ArithIEval(t,v) Yap_Eval(Deref(t),v) - -#define E_FUNC Term -#define E_ARGS -#define USE_E_ARGS - #include "arith2.h" /* @@ -11461,6 +11423,729 @@ Yap_absmi(int inp) ENDD(d0); ENDBOp(); +#ifdef EXPERIMENTAL + Op(eqc_float, sDl); + if (!Yap_isint[PREG->u.sDl.s] && Yap_floats[PREG->u.sDl.s] == PREG->u.sDl.D) { + PREG = NEXTOP(PREG, sDl); + GONext(); + } + PREG = PREG->u.sDl.F; + GONext(); + ENDOp(); + + Op(eqc_int, snl); + if (Yap_isint[PREG->u.sDl.s] && Yap_int[PREG->u.snl.s] == PREG->u.snl.I) { + PREG = NEXTOP(PREG, snl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + ENDOp(); + + Op(eq, ssl); + if (Yap_isint[PREG->u.ssl.s1]) { + if (Yap_isint[PREG->u.ssl.s2] && Yap_int[PREG->u.ssl.s2] == Yap_int[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } else { + if (!Yap_isint[PREG->u.ssl.s2] && Yap_floats[PREG->u.ssl.s2] == Yap_floats[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } + ENDOp(); + + Op(ltc_float, sDl); + { + Float d0; + if (Yap_isint[PREG->u.sDl.s]) + d0 = Yap_int[PREG->u.sDl.s]; + else + d0 = Yap_floats[PREG->u.sDl.s]; + if ( d0 > PREG->u.sDl.D) { + PREG = NEXTOP(PREG, sDl); + GONext(); + } + PREG = PREG->u.sDl.F; + GONext(); + } + ENDOp(); + + Op(ltc_int, snl); + { + Float d0; + if (Yap_isint[PREG->u.snl.s]) + d0 = Yap_int[PREG->u.snl.s]; + else + d0 = Yap_floats[PREG->u.snl.s]; + if ( d0 > PREG->u.snl.I) { + PREG = NEXTOP(PREG, snl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + ENDOp(); + + Op(gtc_float, sDl); + { + Float d0; + if (Yap_isint[PREG->u.sDl.s]) + d0 = Yap_int[PREG->u.sDl.s]; + else + d0 = Yap_floats[PREG->u.sDl.s]; + if ( d0 < PREG->u.sDl.D) { + PREG = NEXTOP(PREG, sDl); + GONext(); + } + PREG = PREG->u.sDl.F; + GONext(); + } + ENDOp(); + + Op(gtc_int, snl); + { + Float d0; + if (Yap_isint[PREG->u.snl.s]) + d0 = Yap_int[PREG->u.snl.s]; + else + d0 = Yap_floats[PREG->u.snl.s]; + if ( d0 < PREG->u.snl.I) { + PREG = NEXTOP(PREG, snl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + ENDOp(); + + Op(lt, ssl); + if (Yap_isint[PREG->u.ssl.s1]) { + if (Yap_isint[PREG->u.ssl.s2]) { + if (Yap_int[PREG->u.ssl.s2] < Yap_int[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } else { + if (Yap_int[PREG->u.ssl.s2] < Yap_floats[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } + } else { + if (Yap_isint[PREG->u.ssl.s2]) { + if (Yap_floats[PREG->u.ssl.s2] < Yap_int[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } else { + if (Yap_floats[PREG->u.ssl.s2] < Yap_floats[PREG->u.ssl.s2]) { + PREG = NEXTOP(PREG, ssl); + GONext(); + } + PREG = PREG->u.snl.F; + GONext(); + } + } + ENDOp(); + + Op(add_float_c, ssD); + if (Yap_isint[PREG->u.ssD.s1]) + Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]+PREG->u.ssD.D; + else + Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]+PREG->u.ssD.D; + Yap_isint[PREG->u.ssD.s0] = FALSE; + PREG = NEXTOP(PREG, ssD); + GONext(); + ENDOp(); + + Op(add_int_c, ssn); + { + int off = PREG->u.ssn.s0; + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_floats[off] = Yap_int[PREG->u.ssn.s1]+PREG->u.ssn.I; + Yap_isint[off] = TRUE; + if (add_overflow(Yap_ints[off],Yap_int[PREG->u.ssn.s1],PREG->u.ssn.I) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = Yap_floats[PREG->u.ssn.s1]+PREG->u.ssn.I; + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(add, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]+Yap_int[PREG->u.sss.s2]; + Yap_isint[off] = TRUE; + if (add_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],PREG->u.sss.s2) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = Yap_int[PREG->u.sss.s1]+Yap_floats[PREG->u.sss.s2]; + Yap_isint[off] = FALSE; + } + } else { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]+Yap_int[PREG->u.sss.s2]; + } else { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]+Yap_floats[PREG->u.sss.s2]; + } + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(sub_float_c, ssD); + if (Yap_isint[PREG->u.ssD.s1]) + Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D-Yap_int[PREG->u.ssDl.s1]; + else + Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D-Yap_floats[PREG->u.ssDl.s1]; + Yap_isint[PREG->u.ssD.s0] = FALSE; + PREG = NEXTOP(PREG, ssD); + GONext(); + ENDOp(); + + Op(sub_int_c, ssn); + { + int off = PREG->u.ssn.s0; + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_floats[off] = PREG->u.ssn.I-Yap_int[PREG->u.ssn.s1]; + Yap_isint[off] = TRUE; + if (sub_overflow(Yap_ints[off],PREG->u.ssn.I,Yap_int[PREG->u.ssn.s1]) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = PREG->u.ssn.I-Yap_floats[PREG->u.ssn.s1]; + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(sub, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]-Yap_int[PREG->u.sss.s2]; + Yap_isint[off] = TRUE; + if (sub_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2]) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = Yap_int[PREG->u.sss.s1]-Yap_floats[PREG->u.sss.s2]; + Yap_isint[off] = FALSE; + } + } else { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]-Yap_int[PREG->u.sss.s2]; + } else { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]-Yap_floats[PREG->u.sss.s2]; + } + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(mul_float_c, ssD); + if (Yap_isint[PREG->u.ssD.s1]) + Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]*PREG->u.ssD.D; + else + Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]*PREG->u.ssD.D; + Yap_isint[PREG->u.ssD.s0] = FALSE; + PREG = NEXTOP(PREG, ssD); + GONext(); + ENDOp(); + + Op(mul_int_c, ssn); + { + int off = PREG->u.ssn.s0; + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_floats[off] = Yap_int[PREG->u.ssn.s1]*PREG->u.ssn.I; + Yap_isint[off] = TRUE; + if (mul_overflow(Yap_ints[off],Yap_int[PREG->u.ssn.s1],PREG->u.ssn.I) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = Yap_floats[PREG->u.ssn.s1]*PREG->u.ssn.I; + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(mul, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]*Yap_int[PREG->u.sss.s2]; + Yap_isint[off] = TRUE; + if (mul_overflow(Yap_ints[off],Yap_int[PREG->u.sss.s1],PREG->u.sss.s2) + PREG = Yap_EvalException(PREG); + } else { + Yap_floats[off] = Yap_int[PREG->u.sss.s1]*Yap_floats[PREG->u.sss.s2]; + Yap_isint[off] = FALSE; + } + } else { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]*Yap_int[PREG->u.sss.s2]; + } else { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]*Yap_floats[PREG->u.sss.s2]; + } + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(fdiv_c1, ssD); + if (Yap_isint[PREG->u.ssD.s1]) + Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D/Yap_int[PREG->u.ssDl.s1]; + else + Yap_floats[PREG->u.ssD.s0] = PREG->u.ssD.D/Yap_floats[PREG->u.ssDl.s1]; + Yap_isint[PREG->u.ssD.s0] = FALSE; + PREG = NEXTOP(PREG, ssD); + GONext(); + ENDOp(); + + Op(fdiv_c2, ssD); + if (Yap_isint[PREG->u.ssD.s1]) + Yap_floats[PREG->u.ssD.s0] = Yap_int[PREG->u.ssDl.s1]/PREG->u.ssD.D; + else + Yap_floats[PREG->u.ssD.s0] = Yap_floats[PREG->u.ssDl.s1]/PREG->u.ssD.D; + Yap_isint[PREG->u.ssD.s0] = FALSE; + PREG = NEXTOP(PREG, ssD); + GONext(); + ENDOp(); + + Op(fdiv, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_floats[off] = ((Float)Yap_int[PREG->u.sss.s1])/Yap_int[PREG->u.sss.s2]; + } else { + Yap_floats[off] = ((Float)Yap_int[PREG->u.sss.s1])/Yap_floats[PREG->u.sss.s2]; + } + } else { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]/Yap_int[PREG->u.sss.s2]; + } else { + Yap_floats[off] = Yap_floats[PREG->u.sss.s1]/Yap_floats[PREG->u.sss.s2]; + } + } + Yap_isint[off] = FALSE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(idiv_c1, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (Yap_int[PREG->u.ssn.s1] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D/Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(idiv_c2, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]/PREG->u.ssn.D; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssD.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(mod, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + if (Yap_int[PREG->u.sss.s2] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_ints[off] = Yap_int[PREG->u.sss.s1]/Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(mod_c1, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (Yap_int[PREG->u.ssn.s1] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = mod(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1]); + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(mod_c2, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = mod(Yap_int[PREG->u.ssnl.s1],PREG->u.ssn.D); + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssD.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(mod, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + if (Yap_int[PREG->u.sss.s2] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_ints[off] = mod(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2]); + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(rem_c1, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (Yap_int[PREG->u.ssn.s1] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D%Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(rem_c2, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssnl.s1]%PREG->u.ssn.D; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssD.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(rem, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + if (Yap_int[PREG->u.sss.s2] == 0) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_ints[off] = Yap_int[PREG->u.sss.s1]%Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(or_c, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D|Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(or, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]|Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(and_c, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D&Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(and, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]&Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(xor_c, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D^Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(xor, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + Yap_ints[off] = Yap_int[PREG->u.sss.s1]^Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(uminus, ss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.ss.s1]) { + Yap_ints[off] = -Yap_int[PREG->u.ss.s1]; + Yap_isint[off] = TRUE; + } else { + Yap_floats[off] = -Yap_floats[PREG->u.ss.s1]; + Yap_isint[off] = FALSE; + } + } + PREG = NEXTOP(PREG, ss); + GONext(); + ENDOp(); + + Op(sl_c1, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (sl_overflow(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1])) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D<u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(sl_c2, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (sl_overflow(Yap_int[PREG->u.ssn.s1],PREG->u.ssn.D)) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]<u.ssn.D; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(sl, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + if (sl_overflow(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2])) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_ints[off] = Yap_int[PREG->u.sss.s1]<u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + + Op(sr_c1, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (sr_overflow(PREG->u.ssn.D,Yap_int[PREG->u.ssn.s1])) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = PREG->u.ssn.D>>Yap_int[PREG->u.ssn.s1]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(sr_c2, ssn); + if (Yap_isint[PREG->u.ssn.s1]) { + if (sr_overflow(Yap_int[PREG->u.ssn.s1],PREG->u.ssn.D)) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_int[PREG->u.ssn.s0] = Yap_int[PREG->u.ssn.s1]>>PREG->u.ssn.D; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[PREG->u.ssn.s0] = TRUE; + PREG = NEXTOP(PREG, ssn); + GONext(); + ENDOp(); + + Op(sr, sss); + { + int off = PREG->u.sss.s0; + if (Yap_isint[PREG->u.sss.s1]) { + if (Yap_isint[PREG->u.sss.s2]) { + if (sr_overflow(Yap_int[PREG->u.sss.s1],Yap_int[PREG->u.sss.s2])) { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_ints[off] = Yap_int[PREG->u.sss.s1]>>Yap_int[PREG->u.sss.s2]; + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + } else { + PREG = Yap_EvalException(PREG); + GONext(); + } + Yap_isint[off] = TRUE; + } + PREG = NEXTOP(PREG, sss); + GONext(); + ENDOp(); + +#endif /* EXPERIMENTAL */ + Op(p_equal, e); save_hb(); if (Yap_IUnify(ARG1, ARG2) == FALSE) { diff --git a/C/arith0.c b/C/arith0.c index e840e99fb..289447962 100644 --- a/C/arith0.c +++ b/C/arith0.c @@ -29,13 +29,6 @@ static char SccsId[] = "%W% %G%"; #include "eval.h" -#define E_FUNC blob_type -#define E_ARGS arith_retptr o - -#define RINT(v) (o)->Int = v; return(long_int_e) -#define RFLOAT(v) (o)->dbl = v; return(double_e) -#define RERROR() return(db_ref_e) - #ifndef PI #ifdef M_PI #define PI M_PI @@ -44,163 +37,132 @@ static char SccsId[] = "%W% %G%"; #endif #endif -static E_FUNC -p_pi(E_ARGS) -{ - RFLOAT(PI); -} - #ifndef M_E #define M_E 2.7182818284590452354 #endif -static E_FUNC -p_e(E_ARGS) -{ - RFLOAT(M_E); -} - #ifndef INFINITY #define INFINITY (1.0/0.0) #endif -static E_FUNC -p_inf(E_ARGS) -{ -#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ - Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); - P = (yamop *)FAILCODE; - RERROR(); -#else - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ - Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(INFINITY); - } -#endif -} - #ifndef NAN #define NAN (0.0/0.0) #endif - -static E_FUNC -p_nan(E_ARGS) -{ +static Term +eval0(Int fi) { + arith0_op fop = fi; + switch (fop) { + case op_pi: + { + RFLOAT(PI); + } + case op_e: + { + RFLOAT(M_E); + } + case op_inf: + { #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ - Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); - P = (yamop *)FAILCODE; - RERROR(); + Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); + P = (yamop *)FAILCODE; + RERROR(); #else - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ - Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number"); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(NAN); + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ + Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(INFINITY); + } +#endif + } + case op_nan: + { +#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ + Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity"); + P = (yamop *)FAILCODE; + RERROR(); +#else + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {/* iso */ + Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating not-a-number"); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(NAN); + } +#endif + } + case op_random: + { + RFLOAT(Yap_random()); + } + case op_cputime: + { + RFLOAT((Float)Yap_cputime()/1000.0); + } + case op_heapused: + RINT(HeapUsed); + case op_localsp: +#if SBA + RINT((Int)ASP); +#else + RINT(LCL0 - ASP); +#endif + case op_b: +#if SBA + RINT((Int)B); +#else + RINT(LCL0 - (CELL *)B); +#endif + case op_env: +#if SBA + RINT((Int)YENV); +#else + RINT(LCL0 - YENV); +#endif + case op_tr: +#if SBA + RINT(TR); +#else + RINT(((CELL *)TR)-LCL0); +#endif + case op_stackfree: + RINT(Unsigned(ASP) - Unsigned(H)); + case op_globalsp: +#if SBA + RINT((Int)H); +#else + RINT(H - H0); +#endif } -#endif + RERROR(); } -static E_FUNC -p_random(E_ARGS) +Term Yap_eval_atom(Int f) { - RFLOAT(Yap_random()); + return eval0(f); } -static E_FUNC -p_cputime(E_ARGS) -{ - RFLOAT((Float)Yap_cputime()/1000.0); -} - -static E_FUNC -p_heapused(E_ARGS) -{ - RINT(HeapUsed); -} - -static E_FUNC -p_localsp(E_ARGS) -{ -#if SBA - RINT((Int)ASP); -#else - RINT(LCL0 - ASP); -#endif -} - -static E_FUNC -p_b(E_ARGS) -{ -#if SBA - RINT((Int)B); -#else - RINT(LCL0 - (CELL *)B); -#endif -} - -static E_FUNC -p_env(E_ARGS) -{ -#if SBA - RINT((Int)YENV); -#else - RINT(LCL0 - YENV); -#endif -} - -static E_FUNC -p_tr(E_ARGS) -{ -#if SBA - RINT(TR); -#else - RINT(((CELL *)TR)-LCL0); -#endif -} - -static E_FUNC -p_globalsp(E_ARGS) -{ -#if SBA - RINT((Int)H); -#else - RINT(H - H0); -#endif -} - -static E_FUNC -p_stackfree(E_ARGS) -{ - RINT(Unsigned(ASP) - Unsigned(H)); -} - -typedef blob_type (*f_constexp)(arith_retptr); - typedef struct init_const_eval { char *OpName; - f_constexp f; + arith0_op f; } InitConstEntry; - static InitConstEntry InitConstTab[] = { - {"pi", p_pi}, - {"e", p_e}, - {"inf", p_inf}, - {"nan", p_nan}, - {"random", p_random}, - {"cputime", p_cputime}, - {"heapused", p_heapused}, - {"local_sp", p_localsp}, - {"global_sp", p_globalsp}, - {"$last_choice_pt", p_b}, - {"$env", p_env}, - {"$tr", p_tr}, - {"stackfree", p_stackfree}, + {"pi", op_pi}, + {"e", op_e}, + {"inf", op_inf}, + {"nan", op_nan}, + {"random", op_random}, + {"cputime", op_cputime}, + {"heapused", op_heapused}, + {"local_sp", op_localsp}, + {"global_sp", op_globalsp}, + {"$last_choice_pt", op_b}, + {"$env", op_env}, + {"$tr", op_tr}, + {"stackfree", op_stackfree}, }; void @@ -224,7 +186,7 @@ Yap_InitConstExps(void) p->KindOfPE = ExpProperty; p->ArityOfEE = 0; p->ENoOfEE = 0; - p->FOfEE.constant = InitConstTab[i].f; + p->FOfEE = InitConstTab[i].f; p->NextOfPE = ae->PropsOfAE; ae->PropsOfAE = AbsExpProp(p); WRITE_UNLOCK(ae->ARWLock); @@ -235,20 +197,6 @@ Yap_InitConstExps(void) int Yap_ReInitConstExps(void) { - unsigned int i; - Prop p; - - for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) { - AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitConstTab[i].OpName)); - - WRITE_LOCK(ae->ARWLock); - if (!(p = Yap_GetExpPropHavingLock(ae, 0))) { - WRITE_UNLOCK(ae->ARWLock); - return FALSE; - } - RepExpProp(p)->FOfEE.constant = InitConstTab[i].f; - WRITE_UNLOCK(ae->ARWLock); - } return TRUE; } diff --git a/C/arith1.c b/C/arith1.c index a57dfec51..1b343565c 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: arith1.c * -* Last rev: * -* mods: * -* comments: arithmetical expression evaluation * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: arith1.c * + * Last rev: * + * mods: * + * comments: arithmetical expression evaluation * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -28,32 +28,24 @@ static char SccsId[] = "%W% %G%"; #include "Heap.h" #include "eval.h" -#define E_FUNC blob_type -#define E_ARGS , arith_retptr o - -#define TMP_BIG() ((o)->big) -#define RINT(v) (o)->Int = v; return(long_int_e) -#define RFLOAT(v) (o)->dbl = v; return(double_e) -#define RBIG(v) return(big_int_e) -#define RERROR() return(db_ref_e) - -#if USE_GMP -static blob_type -float_to_int(Float v, union arith_ret *o) +static Term +float_to_int(Float v) { Int i = (Int)v; +#if USE_GMP if (i-v == 0.0) { - o->Int = i; - return long_int_e; + return MkIntegerTerm(i); } else { - mpz_init_set_d(o->big, v); - return big_int_e; + MP_INT o; + mpz_init_set_d(&o, v); + return Yap_MkBigIntTerm(&o); } -} -#define RBIG_FL(v) return(float_to_int(v,o)) #else -#define RBIG_FL(v) (o)->Int = (Int)(v); return long_int_e + return MkIntegerTerm(v); #endif +} + +#define RBIG_FL(v) return(float_to_int(v)) #if USE_GMP static void @@ -74,47 +66,9 @@ process_iso_error(MP_INT *big, Term t, char *operation) } #endif -inline static Functor -AritFunctorOfTerm(Term t) { - if (IsVarTerm(t)) { - return(FunctorDBRef); - } - if (IsApplTerm(t)) { - return(FunctorOfTerm(t)); - } else { - if (IsIntTerm(t)) - return(FunctorLongInt); - else - return(FunctorDBRef); - } -} - -static Term -EvalToTerm(blob_type f, union arith_ret *res) -{ - switch (f) { - case long_int_e: - return(MkIntegerTerm(res->Int)); - case double_e: - return(MkFloatTerm(res->dbl)); -#ifdef USE_GMP - case big_int_e: - { - Term t = Yap_MkBigIntTerm(res->big); - mpz_clear(res->big); - return t; - } -#endif - default: - return TermNil; - } -} - -typedef blob_type (*f_unexp)(Term, arith_retptr); - typedef struct init_un_eval { char *OpName; - f_unexp f; + arith1_op f; } InitUnEntry; /* Some compilers just don't get it */ @@ -136,1234 +90,24 @@ typedef struct init_un_eval { #define atanh(F) (log((1+(F))/(1-(F)))/2) #endif -/* - do nothing... -*/ -static E_FUNC -p_uplus(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - blob_type bt; - union arith_ret v; - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(IntegerOfTerm(t)); - case double_e: - RFLOAT(FloatOfTerm(t)); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - mpz_init_set(new, Yap_BigIntOfTerm(t)); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(v.Int); - case double_e: - RFLOAT(v.dbl); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - MPZ_SET(new, v.big); - RBIG(new); - } -#endif - default: - /* Error */ - RERROR(); - } +static inline Float +get_float(Term t) { + if (IsFloatTerm(t)) { + return FloatOfTerm(t); } -} - -/* - unary minus: - -*/ -static E_FUNC -p_uminus(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - { - #ifdef USE_GMP - Int i = IntegerOfTerm(t); - - if (i == Int_MIN) { - MP_INT *new = TMP_BIG(); - - mpz_init_set_si(new, i); - mpz_neg(new, new); - RBIG(new); - } - else -#endif - RINT(-IntegerOfTerm(t)); - } - case double_e: - RFLOAT(-FloatOfTerm(t)); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - mpz_init_set(new, Yap_BigIntOfTerm(t)); - mpz_neg(new, new); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(-v.Int); - case double_e: - RFLOAT(-v.dbl); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - mpz_init_set(new, v.big); - mpz_neg(new, new); - mpz_clear(v.big); - RBIG(new); - } -#endif - default: - /* Error */ - RERROR(); - } + if (IsIntTerm(t)) { + return IntOfTerm(t); } -} - -/* - unary negation is \ -*/ -static E_FUNC -p_unot(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(~IntegerOfTerm(t)); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - mpz_init_set(new, Yap_BigIntOfTerm(t)); - mpz_com(new, new); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(~v.Int); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "\\(%f)", v.dbl); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v.big); - mpz_com(new, new); - RBIG(new); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } + if (IsLongIntTerm(t)) { + return LongIntOfTerm(t); } -} - -/* - exponentiation exp(x) -*/ -static E_FUNC -p_exp(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RFLOAT(exp(IntegerOfTerm(t))); - case double_e: - RFLOAT(exp(FloatOfTerm(t))); #ifdef USE_GMP - case big_int_e: - RFLOAT(exp(mpz_get_d(Yap_BigIntOfTerm(t)))); -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RFLOAT(exp(v.Int)); - case double_e: - RFLOAT(exp(v.dbl)); -#ifdef USE_GMP - case big_int_e: - { - double dbl = mpz_get_d(v.big); - - mpz_clear(v.big); - RFLOAT(exp(dbl)); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } -} - -/* - natural logarithm log(x) -*/ -static E_FUNC -p_log(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (dbl >= 0) { - RFLOAT(log(dbl)); - } else { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -} - -/* - base 10 logarithm log10(x) -*/ -static E_FUNC -p_log10(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (dbl >= 0) { - RFLOAT(log10(dbl)); - } else { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log10(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -} - -/* - square root sqrt(x) -*/ -static E_FUNC -p_sqrt(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl, out; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - out = sqrt(dbl); -#if HAVE_ISNAN - if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); + if (IsBigIntTerm(t)) { + return mpz_get_d(Yap_BigIntOfTerm(t)); } #endif - RFLOAT(out); -} - -/* - sine sin(x) ? why did they take the e -*/ -static E_FUNC -p_sin(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(sin(dbl)); -} - -/* - cosine cos(x) -*/ -static E_FUNC -p_cos(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(cos(dbl)); -} - -/* - tangent tan(x) -*/ -static E_FUNC -p_tan(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(tan(dbl)); -} - -/* - hyperbolic sine sinh(x) = (exp(x) - exp(-x)) / 2. -*/ -static E_FUNC -p_sinh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(sinh(dbl)); -} - -/* - hyperbolic cosine cosh(x) = (exp(x) + exp(-x)) / 2. -*/ -static E_FUNC -p_cosh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(cosh(dbl)); -} - -/* - hyperbolic tangent tanh(x) -*/ -static E_FUNC -p_tanh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(tanh(dbl)); -} - -/* - asin(x) arc sine function -*/ -static E_FUNC -p_asin(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl, out; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - out = asin(dbl); -#if HAVE_ISNAN - if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "asin(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -#endif - RFLOAT(out); -} - -/* - acos(x) arc cosine function -*/ -static E_FUNC -p_acos(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl, out; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - out = acos(dbl); -#if HAVE_ISNAN - if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -#endif - RFLOAT(out); -} - -/* - atan(x) arc tangent function -*/ -static E_FUNC -p_atan(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(atan(dbl)); -} - -/* - asinh(x) arc hyperbolic sine -*/ -static E_FUNC -p_asinh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - RFLOAT(asinh(dbl)); -} - -/* - acosh(x) arc hyperbolic cosine -*/ -static E_FUNC -p_acosh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl, out; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - out = acosh(dbl); -#if HAVE_ISNAN - if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acosh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -#endif - RFLOAT(out); -} - -/* - atanh(x) arc hyperbolic tangent -*/ -static E_FUNC -p_atanh(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl, out; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - out = atanh(dbl); -#if HAVE_ISNAN - if (isnan(out)) { - Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); - P = (yamop *)FAILCODE; - RERROR(); - } -#endif - RFLOAT(out); -} - -/* - lgamma(x) is the logarithm of the gamma function. -*/ -static E_FUNC -p_lgamma(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - dbl = IntegerOfTerm(t); - break; - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - break; -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - dbl = v.Int; - break; - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - break; -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - -#if HAVE_LGAMMA - { - Float out; - out = lgamma(dbl); - RFLOAT(out); - } -#else - RERROR(); -#endif -} - -/* - floor(x) maximum integer greatest or equal to X - - There are really two built-ins: - SICStus converts from int/big/float -> float - ISO only converts from float -> int/big - -*/ -static E_FUNC -p_floor(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(IntegerOfTerm(t)); - } - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - MP_INT *big = Yap_BigIntOfTerm(t); - Int sz = 2+mpz_sizeinbase(big,10); - char *s = Yap_AllocCodeSpace(sz); - - if (s != NULL) { - mpz_get_str(s, 10, big); - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s); - P = (yamop *)FAILCODE; - Yap_FreeCodeSpace(s); - RERROR(); - } else { - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)"); - P = (yamop *)FAILCODE; - RERROR(); - } - } else { - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", v.Int); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(v.Int); - } - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Int sz = 2+mpz_sizeinbase(v.big,10); - char *s = Yap_AllocCodeSpace(sz); - - if (s != NULL) { - mpz_get_str(s, 10, v.big); - mpz_clear(v.big); - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s); - Yap_FreeCodeSpace(s); - P = (yamop *)FAILCODE; - RERROR(); - } else { - mpz_clear(v.big); - Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)"); - P = (yamop *)FAILCODE; - RERROR(); - } - } else { - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - RBIG_FL(floor(dbl)); - } else { - RFLOAT(floor(dbl)); - } -} - -/* - ceiling(x) minimum integer smallest or equal to X -*/ -static E_FUNC -p_ceiling(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(IntegerOfTerm(t)); - } - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling"); - RERROR(); - } else { - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", v.Int); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(v.Int); - } - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(v.big, t, "ceiling"); - mpz_clear(v.big); - RERROR(); - } else { - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - RBIG_FL(ceil(dbl)); - } else { - RFLOAT(ceil(dbl)); - } + return 0.0; } /* WIN32 machines do not necessarily have rint. This will do for now */ @@ -1393,268 +137,6 @@ double my_rint(double x) } #endif -/* - round(x) integer closest to 0 -*/ -static E_FUNC -p_round(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(IntegerOfTerm(t)); - } - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { - process_iso_error(Yap_BigIntOfTerm(t), t, "round"); - RERROR(); - } else { - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", v.Int); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(v.Int); - } - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(v.big, t, "round"); - mpz_clear(v.big); - RERROR(); - } else { - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - double vl = my_rint(dbl); - RBIG_FL(vl); - } else { - double vl = my_rint(dbl); - RFLOAT(vl); - } -} - -/* - truncate(x) integer closest to 0 -*/ -static E_FUNC -p_truncate(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(IntegerOfTerm(t)); - } - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "truncate"); - RERROR(); - } else { - dbl = mpz_get_d(Yap_BigIntOfTerm(t)); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%f)", v.Int); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(v.Int); - } - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(v.big, t, "truncate"); - mpz_clear(v.big); - RERROR(); - } else { - dbl = mpz_get_d(v.big); - mpz_clear(v.big); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - - if (dbl >= 0 ) { - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - RBIG_FL(floor(dbl)); - } else { - RFLOAT(floor(dbl)); - } - } else { - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - RBIG_FL(ceil(dbl)); - } else { - RFLOAT(ceil(dbl)); - } - } -} - -/* - integer(x) SICStus integer closest to 0, similar to truncate -*/ -static E_FUNC -p_integer(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(IntegerOfTerm(t)); - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - mpz_init_set(new, Yap_BigIntOfTerm(t)); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(v.Int); - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new,v.big); - RBIG(new); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } - if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) { - RINT((Int) dbl); - } else { -#ifdef USE_GMP - MP_INT *new = TMP_BIG(); - - mpz_init_set_d(new, dbl); - RBIG(new); -#else - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1"); - P = (yamop *)FAILCODE; - RERROR(); -#endif - } -} - -/* - float(x) SICStus float -*/ -static E_FUNC -p_float(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RFLOAT(IntegerOfTerm(t)); - case double_e: - RFLOAT(FloatOfTerm(t)); -#ifdef USE_GMP - case big_int_e: - RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RFLOAT(v.Int); - case double_e: - RFLOAT(v.dbl); -#ifdef USE_GMP - case big_int_e: - { - Float dbl = mpz_get_d(v.big); - mpz_clear(v.big); - RFLOAT(dbl); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } -} - static Int msb(Int inp) /* calculate the most significant bit for an integer */ { @@ -1664,7 +146,7 @@ msb(Int inp) /* calculate the most significant bit for an integer */ if (inp < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, MkIntegerTerm(inp), - "msb/1 received %d", inp); + "msb/1 received %d", inp); P = (yamop *)FAILCODE; return(0); } @@ -1680,391 +162,643 @@ msb(Int inp) /* calculate the most significant bit for an integer */ return(out); } -/* - abs(x): absolute value of a number -*/ -static E_FUNC -p_abs(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(labs(IntegerOfTerm(t))); - case double_e: - RFLOAT(fabs(FloatOfTerm(t))); +static Term +eval1(Int fi, Term t) { + arith1_op f = fi; + switch (f) { + case op_uplus: + return t; + case op_uminus: + switch (ETypeOfTerm(t)) { + case long_int_e: + { #ifdef USE_GMP - case big_int_e: + Int i = IntegerOfTerm(t); + + if (i == Int_MIN) { + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_neg(&new, &new); + RBIG(&new); + } + else +#endif + RINT(-IntegerOfTerm(t)); + } + case double_e: + RFLOAT(-FloatOfTerm(t)); +#ifdef USE_GMP + case big_int_e: + { + MP_INT new; + + mpz_init_set(&new, Yap_BigIntOfTerm(t)); + mpz_neg(&new, &new); + RBIG(&new); + } +#endif + case db_ref_e: + RERROR(); + } + case op_unot: + switch (ETypeOfTerm(t)) { + case long_int_e: + RINT(~IntegerOfTerm(t)); + case double_e: + Yap_Error(TYPE_ERROR_INTEGER, t, "\\(f)", FloatOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + case big_int_e: +#ifdef USE_GMP + { + MP_INT new; + + mpz_init_set(&new, Yap_BigIntOfTerm(t)); + mpz_com(&new, &new); + RBIG(&new); + } +#endif + case db_ref_e: + RERROR(); + } + case op_exp: + RFLOAT(exp(get_float(t))); + case op_log: { - MP_INT *new = TMP_BIG(); - - mpz_init_set(new, Yap_BigIntOfTerm(t)); - mpz_abs(new, new); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(labs(v.Int)); - case double_e: - RFLOAT(fabs(v.dbl)); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v.big); - mpz_abs(new, new); - RBIG(new); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } -} - -/* - msb(x) most significant bit -*/ -static E_FUNC -p_msb(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(msb(IntegerOfTerm(t))); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - RINT(mpz_sizeinbase(Yap_BigIntOfTerm(t),2)); -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - RINT(v.Int); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", v.dbl); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - { - int sz = mpz_sizeinbase(v.big,2); - - mpz_clear(v.big); - RINT(sz); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - } -} - -/* - float_fractional_part(x) fraction for a float. -*/ -static E_FUNC -p_ffracp(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); - } else { - RFLOAT(0.0); - } - case double_e: - dbl = FloatOfTerm(t); - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part"); - RERROR(); - } else { - RFLOAT(0.0); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", v.Int); + Float dbl = get_float(t); + if (dbl >= 0) { + RFLOAT(log(dbl)); + } else { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); P = (yamop *)FAILCODE; RERROR(); - } else { - RFLOAT(0.0); } - case double_e: - dbl = v.dbl; - break; -#ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(v.big, t, "float_fractional_part"); - mpz_clear(v.big); - RERROR(); + } + case op_log10: + { + Float dbl = get_float(t); + if (dbl >= 0) { + RFLOAT(log10(dbl)); } else { - mpz_clear(v.big); - RFLOAT(0.0); + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "log(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } + } + case op_sqrt: + { + Float dbl = get_float(t), out; + out = sqrt(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "acos(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); } #endif - default: - /* Yap_Error */ - RERROR(); + RFLOAT(out); } - } + case op_sin: + { + Float dbl = get_float(t), out; + out = sin(dbl); + RFLOAT(out); + } + case op_cos: + { + Float dbl = get_float(t), out; + out = cos(dbl); + RFLOAT(out); + } + case op_tan: + { + Float dbl = get_float(t), out; + out = tan(dbl); + RFLOAT(out); + } + case op_sinh: + { + Float dbl = get_float(t), out; + out = sinh(dbl); + RFLOAT(out); + } + case op_cosh: + { + Float dbl = get_float(t), out; + out = cosh(dbl); + RFLOAT(out); + } + case op_tanh: + { + Float dbl = get_float(t), out; + out = tanh(dbl); + RFLOAT(out); + } + case op_asin: + { + Float dbl, out; - RFLOAT(dbl-ceil(dbl)); -} + dbl = get_float(t); + out = asin(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_acos: + { + Float dbl, out; -/* - float_integer_part(x) integer for a float. -*/ -static E_FUNC -p_fintp(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; + dbl = get_float(t); + out = acos(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_atan: + { + Float dbl, out; - switch (BlobOfFunctor(f)) { - case long_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); - P = (yamop *)FAILCODE; + dbl = get_float(t); + out = atan(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_asinh: + { + Float dbl, out; + + dbl = get_float(t); + out = asinh(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_acosh: + { + Float dbl, out; + + dbl = get_float(t); + out = acosh(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_atanh: + { + Float dbl, out; + + dbl = get_float(t); + out = atanh(dbl); +#if HAVE_ISNAN + if (isnan(out)) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t, "atanh(%f)", dbl); + P = (yamop *)FAILCODE; + RERROR(); + } +#endif + RFLOAT(out); + } + case op_lgamma: + { + Float dbl; + + dbl = get_float(t); +#if HAVE_LGAMMA + RFLOAT(lgamma(dbl)); +#else RERROR(); - } else { +#endif + } + /* + floor(x) maximum integer greatest or equal to X + + There are really two built-ins: + SICStus converts from int/big/float -> float + ISO only converts from float -> int/big + + */ + case op_floor: + { + Float dbl; + + switch (ETypeOfTerm(t)) { + case long_int_e: + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%f)", IntegerOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(IntegerOfTerm(t)); + } + case double_e: + dbl = FloatOfTerm(t); + break; + case big_int_e: +#ifdef USE_GMP + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + MP_INT *big = Yap_BigIntOfTerm(t); + Int sz = 2+mpz_sizeinbase(big,10); + char *s = Yap_AllocCodeSpace(sz); + + if (s != NULL) { + mpz_get_str(s, 10, big); + Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(%s)", s); + P = (yamop *)FAILCODE; + Yap_FreeCodeSpace(s); + RERROR(); + } else { + Yap_Error(TYPE_ERROR_FLOAT, t, "X is floor(t)"); + P = (yamop *)FAILCODE; + RERROR(); + } + } else { + dbl = mpz_get_d(Yap_BigIntOfTerm(t)); + } +#endif + case db_ref_e: + RERROR(); + } + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + RBIG_FL(floor(dbl)); + } else { + RFLOAT(floor(dbl)); + } + } + case op_ceiling: + { + Float dbl; + switch (ETypeOfTerm(t)) { + case long_int_e: + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + Yap_Error(TYPE_ERROR_FLOAT, t, "X is ceiling(%f)", IntegerOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(IntegerOfTerm(t)); + } + case double_e: + dbl = FloatOfTerm(t); + break; + case big_int_e: +#ifdef USE_GMP + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + process_iso_error(Yap_BigIntOfTerm(t), t, "ceiling"); + RERROR(); + } else { + dbl = mpz_get_d(Yap_BigIntOfTerm(t)); + } +#endif + case db_ref_e: + RERROR(); + } + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + RBIG_FL(ceil(dbl)); + } else { + RFLOAT(ceil(dbl)); + } + } + case op_round: + { + Float dbl; + + switch (ETypeOfTerm(t)) { + case long_int_e: + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + Yap_Error(TYPE_ERROR_FLOAT, t, "X is round(%f)", IntegerOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(IntegerOfTerm(t)); + } + case double_e: + dbl = FloatOfTerm(t); + break; + case big_int_e: +#ifdef USE_GMP + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { + process_iso_error(Yap_BigIntOfTerm(t), t, "round"); + RERROR(); + } else { + dbl = mpz_get_d(Yap_BigIntOfTerm(t)); + } +#endif + case db_ref_e: + RERROR(); + } + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + double vl = my_rint(dbl); + RBIG_FL(vl); + } else { + double vl = my_rint(dbl); + RFLOAT(vl); + } + } + case op_truncate: + { + Float dbl; + switch (ETypeOfTerm(t)) { + case long_int_e: + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + Yap_Error(TYPE_ERROR_FLOAT, t, "X is truncate(%f)", IntegerOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(IntegerOfTerm(t)); + } + case double_e: + dbl = FloatOfTerm(t); + break; + case big_int_e: +#ifdef USE_GMP + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + process_iso_error(Yap_BigIntOfTerm(t), t, "truncate"); + RERROR(); + } else { + dbl = mpz_get_d(Yap_BigIntOfTerm(t)); + } +#endif + case db_ref_e: + RERROR(); + } + if (dbl >= 0 ) { + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + RBIG_FL(floor(dbl)); + } else { + RFLOAT(floor(dbl)); + } + } else { + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + RBIG_FL(ceil(dbl)); + } else { + RFLOAT(ceil(dbl)); + } + } + } + case op_integer: + { + Float dbl; + switch (ETypeOfTerm(t)) { + case long_int_e: + RINT(IntegerOfTerm(t)); + case double_e: + dbl = FloatOfTerm(t); + break; + case big_int_e: +#ifdef USE_GMP + { + MP_INT new; + mpz_init_set(&new, Yap_BigIntOfTerm(t)); + RBIG(&new); + } +#endif + case db_ref_e: + RERROR(); + } + if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) { + RINT((Int) dbl); + } else { +#ifdef USE_GMP + MP_INT new; + + mpz_init_set_d(&new, dbl); + RBIG(&new); +#else + Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer/1"); + P = (yamop *)FAILCODE; + RERROR(); +#endif + } + } + case op_float: + switch (ETypeOfTerm(t)) { + case long_int_e: RFLOAT(IntegerOfTerm(t)); - } - case double_e: - dbl = FloatOfTerm(t); - break; + case double_e: + RFLOAT(FloatOfTerm(t)); + case big_int_e: #ifdef USE_GMP - case big_int_e: - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part"); - RERROR(); - } else { RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); - } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { + case db_ref_e: + RERROR(); + } + case op_abs: + switch (ETypeOfTerm(t)) { + case long_int_e: + RINT(labs(IntegerOfTerm(t))); + case double_e: + RFLOAT(fabs(FloatOfTerm(t))); + case big_int_e: +#ifdef USE_GMP + { + MP_INT new; + + mpz_init_set(&new, Yap_BigIntOfTerm(t)); + mpz_abs(&new, &new); + RBIG(&new); + } +#endif + case db_ref_e: + RERROR(); + } + case op_msb: + switch (ETypeOfTerm(f)) { + case long_int_e: + RINT(msb(IntegerOfTerm(t))); + case double_e: + Yap_Error(TYPE_ERROR_INTEGER, t, "msb(%f)", FloatOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + case big_int_e: +#ifdef USE_GMP + RINT(mpz_sizeinbase(Yap_BigIntOfTerm(t),2)); +#endif + case db_ref_e: + RERROR(); + } + case op_ffracp: + switch (ETypeOfTerm(f)) { case long_int_e: if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ - Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", v.Int); + Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_fractional_part(%f)", IntegerOfTerm(t)); P = (yamop *)FAILCODE; RERROR(); } else { - RFLOAT(v.Int); + RFLOAT(0.0); } case double_e: - dbl = v.dbl; + { + Float dbl; + dbl = FloatOfTerm(t); + RFLOAT(dbl-ceil(dbl)); + } break; -#ifdef USE_GMP case big_int_e: +#ifdef USE_GMP + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + process_iso_error(Yap_BigIntOfTerm(t), t, "float_fractional_part"); + RERROR(); + } else { + RFLOAT(0.0); + } +#endif + case db_ref_e: + RERROR(); + } + case op_fintp: + switch (ETypeOfTerm(f)) { + case long_int_e: + if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ + Yap_Error(TYPE_ERROR_FLOAT, t, "X is float_integer_part(%f)", IntegerOfTerm(t)); + P = (yamop *)FAILCODE; + RERROR(); + } else { + RFLOAT(IntegerOfTerm(t)); + } + case double_e: + RFLOAT(rint(FloatOfTerm(t))); + break; + case big_int_e: +#ifdef USE_GMP if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { /* iso */ process_iso_error(Yap_BigIntOfTerm(t), t, "float_integer_part"); RERROR(); } else { - Float dbl = mpz_get_d(v.big); - - mpz_clear(v.big); - RFLOAT(dbl); + RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); } #endif - default: - /* Yap_Error */ + case db_ref_e: RERROR(); } - } - RFLOAT(rint(dbl)); -} - -/* - sign(x) sign of a number. -*/ -static E_FUNC -p_sign(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - Float dbl; - - switch (BlobOfFunctor(f)) { - case long_int_e: - { - Int x = IntegerOfTerm(t); - - RINT((x > 0 ? 1 : (x < 0 ? -1 : 0))); - } - case double_e: - dbl = FloatOfTerm(t); - - RINT((dbl > 0.0 ? 1 : (dbl < 0.0 ? -1 : 0))); -#ifdef USE_GMP - case big_int_e: - RINT(mpz_sgn(Yap_BigIntOfTerm(t))); -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { + case op_sign: + switch (ETypeOfTerm(f)) { case long_int_e: - RINT((v.Int > 0 ? 1 : (v.Int < 0 ? -1 : 0))); + { + Int x = IntegerOfTerm(t); + + RINT((x > 0 ? 1 : (x < 0 ? -1 : 0))); + } case double_e: - RINT((v.dbl > 0.0 ? 1 : (v.dbl < 0.0 ? -1 : 0))); -#ifdef USE_GMP + { + + Float dbl = FloatOfTerm(t); + + RINT((dbl > 0.0 ? 1 : (dbl < 0.0 ? -1 : 0))); + } case big_int_e: - { - int sgn = mpz_sgn(v.big); - - mpz_clear(v.big); - RINT(sgn); - } +#ifdef USE_GMP + RINT(mpz_sgn(Yap_BigIntOfTerm(t))); #endif - default: - /* Yap_Error */ + case db_ref_e: RERROR(); } - } -} - -/* - unary negation is \ -*/ -static E_FUNC -p_random(Term t E_ARGS) -{ - Functor f = AritFunctorOfTerm(t); - union arith_ret v; - blob_type bt; - - switch (BlobOfFunctor(f)) { - case long_int_e: - RINT(Yap_random()*IntegerOfTerm(t)); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); - P = (yamop *)FAILCODE; - RERROR(); -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt = Yap_Eval(t, &v); - /* second case, no need no evaluation */ - switch (bt) { + case op_random1: + switch (ETypeOfTerm(t)) { case long_int_e: - RINT(Yap_random()*v.Int); + RINT(Yap_random()*IntegerOfTerm(t)); case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", v.dbl); + Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); P = (yamop *)FAILCODE; RERROR(); -#ifdef USE_GMP case big_int_e: +#ifdef USE_GMP Yap_Error(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); P = (yamop *)FAILCODE; RERROR(); #endif - default: - /* Yap_Error */ + case db_ref_e: RERROR(); } } + RERROR(); +} + +Term Yap_eval_unary(Int f, Term t) +{ + return eval1(f,t); } static InitUnEntry InitUnTab[] = { - {"+", p_uplus}, - {"-", p_uminus}, - {"\\", p_unot}, - {"exp", p_exp}, - {"log", p_log}, - {"log10", p_log10}, - {"sqrt", p_sqrt}, - {"sin", p_sin}, - {"cos", p_cos}, - {"tan", p_tan}, - {"sinh", p_sinh}, - {"cosh", p_cosh}, - {"tanh", p_tanh}, - {"asin", p_asin}, - {"acos", p_acos}, - {"atan", p_atan}, - {"asinh", p_asinh}, - {"acosh", p_acosh}, - {"atanh", p_atanh}, - {"floor", p_floor}, - {"ceiling", p_ceiling}, - {"round", p_round}, - {"truncate", p_truncate}, - {"integer", p_integer}, - {"float", p_float}, - {"abs", p_abs}, - {"msb", p_msb}, - {"float_fractional_part", p_ffracp}, - {"float_integer_part", p_fintp}, - {"sign", p_sign}, - {"lgamma", p_lgamma}, - {"random", p_random}, + {"+", op_uplus}, + {"-", op_uminus}, + {"\\", op_unot}, + {"exp", op_exp}, + {"log", op_log}, + {"log10", op_log10}, + {"sqrt", op_sqrt}, + {"sin", op_sin}, + {"cos", op_cos}, + {"tan", op_tan}, + {"sinh", op_sinh}, + {"cosh", op_cosh}, + {"tanh", op_tanh}, + {"asin", op_asin}, + {"acos", op_acos}, + {"atan", op_atan}, + {"asinh", op_asinh}, + {"acosh", op_acosh}, + {"atanh", op_atanh}, + {"floor", op_floor}, + {"ceiling", op_ceiling}, + {"round", op_round}, + {"truncate", op_truncate}, + {"integer", op_integer}, + {"float", op_float}, + {"abs", op_abs}, + {"msb", op_msb}, + {"float_fractional_part", op_ffracp}, + {"float_integer_part", op_fintp}, + {"sign", op_sign}, + {"lgamma", op_lgamma}, + {"random", op_random1} }; static Int p_unary_is(void) { /* X is Y */ Term t = Deref(ARG2); - union arith_ret res; + Term top; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, ARG2, "X is Y"); return(FALSE); } + top = Yap_Eval(Deref(ARG3)); + if (top == 0L) + return FALSE; if (IsIntTerm(t)) { - blob_type f = InitUnTab[IntOfTerm(t)].f(Deref(ARG3),&res); - return (Yap_unify_constant(ARG1,EvalToTerm(f,&res))); + return Yap_unify_constant(ARG1,eval1(IntOfTerm(t), top)); } if (IsAtomTerm(t)) { Atom name = AtomOfTerm(t); ExpEntry *p; - blob_type f; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 1)))) { Term ti[2]; @@ -2074,13 +808,12 @@ p_unary_is(void) ti[1] = MkIntTerm(1); t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti); Yap_Error(TYPE_ERROR_EVALUABLE, t, - "functor %s/%d for arithmetic expression", - RepAtom(name)->StrOfAE,1); + "functor %s/%d for arithmetic expression", + RepAtom(name)->StrOfAE,1); P = (yamop *)FAILCODE; return(FALSE); } - f = p->FOfEE.unary(Deref(ARG3),&res); - return (Yap_unify_constant(ARG1,EvalToTerm(f,&res))); + return Yap_unify_constant(ARG1,eval1(p->FOfEE, top)); } return(FALSE); } @@ -2106,7 +839,7 @@ Yap_InitUnaryExps(void) p->KindOfPE = ExpProperty; p->ArityOfEE = 1; p->ENoOfEE = 1; - p->FOfEE.unary = InitUnTab[i].f; + p->FOfEE = InitUnTab[i].f; p->NextOfPE = ae->PropsOfAE; ae->PropsOfAE = AbsExpProp(p); WRITE_UNLOCK(ae->ARWLock); @@ -2118,24 +851,6 @@ Yap_InitUnaryExps(void) int Yap_ReInitUnaryExps(void) { - unsigned int i; - Prop p; - - for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) { - AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitUnTab[i].OpName)); - - if (ae == NULL) { - Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at ReInitUnaryExps"); - return FALSE; - } - WRITE_LOCK(ae->ARWLock); - if ((p = Yap_GetExpPropHavingLock(ae, 1)) == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return FALSE; - } - RepExpProp(p)->FOfEE.unary = InitUnTab[i].f; - WRITE_UNLOCK(ae->ARWLock); - } return TRUE; } diff --git a/C/arith2.c b/C/arith2.c index 138fb6c48..bc21f6ac2 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: arith2.c * -* Last rev: * -* mods: * -* comments: arithmetical expression evaluation * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: arith2.c * + * Last rev: * + * mods: * + * comments: arithmetical expression evaluation * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -28,441 +28,13 @@ static char SccsId[] = "%W% %G%"; #include "Heap.h" #include "eval.h" -#define E_FUNC blob_type -#define E_ARGS , arith_retptr o -#define USE_E_ARGS , o - -#define TMP_BIG() ((o)->big) -#define RINT(v) (o)->Int = (v); return(long_int_e) -#define RFLOAT(v) (o)->dbl = (v); return(double_e) -#define RBIG(v) return(big_int_e) -#define RERROR() return(db_ref_e) - -#define ArithIEval(t,v) Yap_Eval(t,v) - -inline static Functor -AritFunctorOfTerm(Term t) { - if (IsVarTerm(t)) { - return(FunctorPortray); - } - if (IsApplTerm(t)) { - return(FunctorOfTerm(t)); - } else { - if (IsIntTerm(t)) - return(FunctorLongInt); - else - return(FunctorDBRef); - } -} - -inline static Term -EvalToTerm(blob_type f, union arith_ret *res) -{ - switch (f) { - case long_int_e: - return(MkIntegerTerm(res->Int)); - case double_e: - return(MkFloatTerm(res->dbl)); -#ifdef USE_GMP - case big_int_e: - { - Term t = Yap_MkBigIntTerm(res->big); - mpz_clear(res->big); - return t; - } -#endif - default: - return(TermNil); - } -} - -typedef blob_type (*f_binexp)(Term, Term, arith_retptr); - -typedef struct init_bin_eval { - char *OpName; - f_binexp f; -} InitBinEntry; - #include "arith2.h" -/* - modulus mod (* now follows ISO standard *) -*/ -static E_FUNC -p_mod(Term t1, Term t2 E_ARGS) -{ - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; +typedef struct init_un_eval { + char *OpName; + arith2_op f; +} InitBinEntry; - switch (BlobOfFunctor(f1)) { - case (CELL)long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { - case (CELL)long_int_e: - /* two integers */ - { - Int i1 = IntegerOfTerm(t1); - Int i2 = IntegerOfTerm(t2); - Int mod; - - if (i2 == 0) goto zero_divisor; - mod = i1%i2; - if (mod && (mod ^ i2) < 0) - mod += i2; - RINT(mod); - } - case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - /* I know the term is much larger, so: */ - { - MP_INT *new = TMP_BIG(); - Int i1 = IntegerOfTerm(t1); - - mpz_init_set_si(new, i1); - mpz_fdiv_r(new, new, Yap_BigIntOfTerm(t2)); - RBIG(new); - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); - } - break; - case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, "mod/2"); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { - case long_int_e: - /* modulo between bignum and integer */ - { - mpz_t tmp; - MP_INT *new = TMP_BIG(); - Int i2 = IntegerOfTerm(t2); - - if (i2 == 0) goto zero_divisor; - mpz_init(new); - mpz_init_set_si(tmp, i2); - mpz_fdiv_r(new, Yap_BigIntOfTerm(t1), tmp); - mpz_clear(tmp); - RBIG(new); - } - case (CELL)big_int_e: - /* two bignums */ - { - MP_INT *new = TMP_BIG(); - - mpz_init(new); - mpz_fdiv_r(new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); - RBIG(new); - } - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); - } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - { - Int i1 = v1.Int; - Int i2 = v2.Int; - Int mod; - - if (i2 == 0) goto zero_divisor; - mod = i1%i2; - if (mod && (mod ^ i2) < 0) - mod += i2; - RINT(mod); - } - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - /* I know the term is much larger, so: */ - { - mpz_t tmp; - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v2.big); - mpz_init_set_si(tmp, v1.Int); - mpz_fdiv_r(new, tmp, new); - mpz_clear(tmp); - RBIG(new); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: -#if USE_GMP - if (bt2 == big_int_e) - mpz_clear(v2.big); -#endif - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "mod/2"); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - switch (bt2) { - case long_int_e: - /* big mod integer */ - { - mpz_t tmp; - MP_INT *new = TMP_BIG(); - - if (v2.Int == 0) goto zero_divisor; - MPZ_SET(new,v1.big); - mpz_init_set_si(tmp, v2.Int); - mpz_fdiv_r(new, new, tmp); - mpz_clear(tmp); - RBIG(new); - } - case double_e: - /* big // float */ - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - case (CELL)big_int_e: - /* big * big */ - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - mpz_fdiv_r(new, new, v2.big); - mpz_clear(v2.big); - RBIG(new); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } - zero_divisor: - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -} - -/* - remainder rem (* now follows ISO standard *) -*/ -static E_FUNC -p_rem(Term t1, Term t2 E_ARGS) -{ - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { - case (CELL)long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { - case (CELL)long_int_e: - /* two integers */ - { - Int i1 = IntegerOfTerm(t1); - Int i2 = IntegerOfTerm(t2); - Int mod; - - if (i2 == 0) goto zero_divisor; - mod = i1%i2; - RINT(i1%i2); - } - case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - /* I know the term is much larger, so: */ - RINT(IntegerOfTerm(t1)); -#endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); - } - break; - case (CELL)double_e: - Yap_Error(TYPE_ERROR_INTEGER, t1, "mod/2"); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { - case long_int_e: - /* modulo between bignum and integer */ - { - mpz_t tmp; - MP_INT *new = TMP_BIG(); - Int i2 = IntegerOfTerm(t2); - - if (i2 == 0) goto zero_divisor; - mpz_init(new); - mpz_init_set_si(tmp, i2); - mpz_tdiv_r(new, Yap_BigIntOfTerm(t1), tmp); - mpz_clear(tmp); - RBIG(new); - } - case (CELL)big_int_e: - /* two bignums */ - { - MP_INT *new = TMP_BIG(); - - mpz_init(new); - mpz_tdiv_r(new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); - RBIG(new); - } - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); - } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - { - Int i1 = v1.Int; - Int i2 = v2.Int; - Int mod; - - if (i2 == 0) goto zero_divisor; - mod = i1%i2; - RINT(mod); - } - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - /* Cool */ - mpz_clear(v2.big); - RINT(v1.Int); -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: -#if USE_GMP - if (bt2 == big_int_e) - mpz_clear(v2.big); -#endif - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "mod/2"); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case (CELL)big_int_e: - switch (bt2) { - case long_int_e: - /* big mod integer */ - { - mpz_t tmp; - MP_INT *new = TMP_BIG(); - - if (v2.Int == 0) goto zero_divisor; - MPZ_SET(new,v1.big); - mpz_init_set_si(tmp, v2.Int); - mpz_tdiv_r(new, new, tmp); - mpz_clear(tmp); - RBIG(new); - } - case double_e: - /* big // float */ - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "mod/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - case (CELL)big_int_e: - /* big * big */ - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - mpz_tdiv_r(new, new, v2.big); - mpz_clear(v2.big); - RBIG(new); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } - zero_divisor: - Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -} #ifdef USE_GMP static Float @@ -489,21 +61,184 @@ fdiv_bigint(MP_INT *b1,MP_INT *b2) } #endif +static Term +p_mod(Term t1, Term t2) { + switch (ETypeOfTerm(t1)) { + case (CELL)long_int_e: + switch (ETypeOfTerm(t2)) { + case (CELL)long_int_e: + /* two integers */ + { + Int i1 = IntegerOfTerm(t1); + Int i2 = IntegerOfTerm(t2); + Int mod; + + if (i2 == 0) goto zero_divisor; + mod = i1%i2; + if (mod && (mod ^ i2) < 0) + mod += i2; + RINT(mod); + } + case (CELL)double_e: + Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); +#ifdef USE_GMP + case (CELL)big_int_e: + /* I know the term is much larger, so: */ + { + MP_INT new; + Int i1 = IntegerOfTerm(t1); + + mpz_init_set_si(&new, i1); + mpz_fdiv_r(&new, &new, Yap_BigIntOfTerm(t2)); + RBIG(&new); + } +#endif + case db_ref_e: + RERROR(); + break; + } + case (CELL)double_e: + Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); + case (CELL)big_int_e: +#ifdef USE_GMP + switch (ETypeOfTerm(t2)) { + case long_int_e: + /* modulo between bignum and integer */ + { + mpz_t tmp; + MP_INT new; + Int i2 = IntegerOfTerm(t2); + + if (i2 == 0) goto zero_divisor; + mpz_init(&new); + mpz_init_set_si(tmp, i2); + mpz_fdiv_r(&new, Yap_BigIntOfTerm(t1), tmp); + mpz_clear(tmp); + RBIG(&new); + } + case (CELL)big_int_e: + /* two bignums */ + { + MP_INT new; + + mpz_init(&new); + mpz_fdiv_r(&new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); + RBIG(&new); + } + case double_e: + Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); + case db_ref_e: + RERROR(); + } +#endif + case db_ref_e: + RERROR(); + } +zero_divisor: + Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); +} + +static Term +p_rem(Term t1, Term t2) { + switch (ETypeOfTerm(t1)) { + case (CELL)long_int_e: + switch (ETypeOfTerm(t2)) { + case (CELL)long_int_e: + /* two integers */ + { + Int i1 = IntegerOfTerm(t1); + Int i2 = IntegerOfTerm(t2); + Int mod; + + if (i2 == 0) goto zero_divisor; + mod = i1%i2; + RINT(i1%i2); + } + case (CELL)double_e: + Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); +#ifdef USE_GMP + case (CELL)big_int_e: + /* I know the term is much larger, so: */ + RINT(IntegerOfTerm(t1)); +#endif + case db_ref_e: + RERROR(); + } + break; + case (CELL)double_e: + Yap_Error(TYPE_ERROR_INTEGER, t1, "mod/2"); + P = (yamop *)FAILCODE; + RERROR(); +#ifdef USE_GMP + case (CELL)big_int_e: + switch (ETypeOfTerm(t2)) { + case long_int_e: + /* modulo between bignum and integer */ + { + mpz_t tmp; + MP_INT new; + Int i2 = IntegerOfTerm(t2); + + if (i2 == 0) goto zero_divisor; + mpz_init(&new); + mpz_init_set_si(tmp, i2); + mpz_tdiv_r(&new, Yap_BigIntOfTerm(t1), tmp); + mpz_clear(tmp); + RBIG(&new); + } + case (CELL)big_int_e: + /* two bignums */ + { + MP_INT new; + + mpz_init(&new); + mpz_tdiv_r(&new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); + RBIG(&new); + } + case double_e: + Yap_Error(TYPE_ERROR_INTEGER, t2, "mod/2"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); + case db_ref_e: + RERROR(); + } +#endif + case db_ref_e: + RERROR(); + } + zero_divisor: + Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "X is mod 0"); + /* make GCC happy */ + P = (yamop *)FAILCODE; + RERROR(); +} + + /* Floating point division: / */ -static E_FUNC -p_fdiv(Term t1, Term t2 E_ARGS) +static Term +p_fdiv(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i2 = IntegerOfTerm(t2); @@ -526,17 +261,12 @@ p_fdiv(Term t1, Term t2 E_ARGS) RFLOAT(((Float)i1/f2)); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { @@ -554,18 +284,13 @@ p_fdiv(Term t1, Term t2 E_ARGS) RFLOAT(FloatOfTerm(t1)/mpz_get_d(Yap_BigIntOfTerm(t2))); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.dbl = FloatOfTerm(t1); - bt1 = double_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i = IntegerOfTerm(t2); @@ -580,96 +305,14 @@ p_fdiv(Term t1, Term t2 E_ARGS) Float dbl = FloatOfTerm(t2); RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/dbl); } - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; + case db_ref_e: + RERROR(); } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - RFLOAT((Float)(((float)v1.Int)/(Float)(v2.Int))); - case double_e: - /* integer, double */ - RFLOAT(v1.Int/v2.dbl); -#ifdef USE_GMP - case big_int_e: - /* integer, double */ - { - Float dbl = v1.Int/mpz_get_d(v2.big); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: - switch (bt2) { - case long_int_e: - /* float / integer */ - RFLOAT(v1.dbl/v2.Int); - case double_e: - /* float / float */ - RFLOAT(v1.dbl/v2.dbl); -#ifdef USE_GMP - case big_int_e: - /* float / float */ - { - Float dbl = v1.dbl/mpz_get_d(v2.big); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* error */ - RERROR(); - } -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - { - Float dbl = mpz_get_d(v1.big)/v2.Int; - mpz_clear(v1.big); - RFLOAT(dbl); - } - case double_e: - { - Float dbl = mpz_get_d(v1.big)/v2.dbl; - mpz_clear(v1.big); - RFLOAT(dbl); - } - case big_int_e: - /* big / big */ - { - Float dbl = fdiv_bigint(v1.big,v2.big); - mpz_clear(v1.big); - mpz_clear(v2.big); - RFLOAT(dbl); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + RERROR(); } #if USE_GMP @@ -696,18 +339,13 @@ mpz_xor(MP_INT *new, MP_INT *r1, MP_INT *r2) /* xor # */ -static E_FUNC -p_xor(Term t1, Term t2 E_ARGS) +static Term +p_xor(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* two integers */ RINT(IntegerOfTerm(t1) ^ IntegerOfTerm(t2)); @@ -718,18 +356,15 @@ p_xor(Term t1, Term t2 E_ARGS) #ifdef USE_GMP case big_int_e: { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set_si(new,IntOfTerm(t1)); - mpz_xor(new, new, Yap_BigIntOfTerm(t2)); - RBIG(new); + mpz_init_set_si(&new,IntOfTerm(t1)); + mpz_xor(&new, &new, Yap_BigIntOfTerm(t2)); + RBIG(&new); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: @@ -738,148 +373,53 @@ p_xor(Term t1, Term t2 E_ARGS) RERROR(); #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set_si(new,IntegerOfTerm(t2)); - mpz_xor(new, Yap_BigIntOfTerm(t1), new); - RBIG(new); + mpz_init_set_si(&new,IntegerOfTerm(t2)); + mpz_xor(&new, Yap_BigIntOfTerm(t1), &new); + RBIG(&new); } case big_int_e: /* two bignums */ { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t1)); - mpz_xor(new, new, Yap_BigIntOfTerm(t2)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t1)); + mpz_xor(&new, &new, Yap_BigIntOfTerm(t2)); + RBIG(&new); } case double_e: Yap_Error(TYPE_ERROR_INTEGER, t2, "#/2"); /* make GCC happy */ P = (yamop *)FAILCODE; RERROR(); - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); - } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - RINT(v1.Int ^ v2.Int); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "#/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - { - MP_INT *new = TMP_BIG(); - - mpz_init_set_si(new,v1.Int); - mpz_xor(new, new, v2.big); - mpz_clear(v2.big); - RBIG(new); - } -#endif - default: - /* Yap_Error */ + case db_ref_e: RERROR(); } - case double_e: -#if USE_GMP - if (bt2 == big_int_e) - mpz_clear(v2.big); #endif - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "#/2"); - P = (yamop *)FAILCODE; + case db_ref_e: RERROR(); -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - /* anding a bignum with an integer is easy */ - { - MP_INT *new = TMP_BIG(); - - mpz_init_set_si(new,v2.Int); - mpz_xor(new, v1.big, new); - mpz_clear(v1.big); - RBIG(new); - } - case double_e: - /* big // float */ - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - case big_int_e: - /* big * big */ - { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - mpz_xor(new, new, v2.big); - mpz_clear(v2.big); - RBIG(new); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + } + RERROR(); } /* atan2: arc tangent x/y */ -static E_FUNC -p_atan2(Term t1, Term t2 E_ARGS) +static Term +p_atan2(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: - { - Int i2 = IntegerOfTerm(t2); - - /* two integers */ - RFLOAT(atan2(IntegerOfTerm(t1),i2)); - } + /* two integers */ + RFLOAT(atan2(IntegerOfTerm(t1),IntegerOfTerm(t2))); case double_e: - { - /* integer, double */ - Float fl1 = (Float)IntegerOfTerm(t1); - Float fl2 = FloatOfTerm(t2); - RFLOAT(atan2(fl1,fl2)); - } + RFLOAT(atan2(IntegerOfTerm(t1),FloatOfTerm(t2))); #ifdef USE_GMP case big_int_e: { @@ -888,17 +428,12 @@ p_atan2(Term t1, Term t2 E_ARGS) RFLOAT(atan2(i1,f2)); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); + break; } - break; case double_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { @@ -916,18 +451,13 @@ p_atan2(Term t1, Term t2 E_ARGS) RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2)))); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.dbl = FloatOfTerm(t1); - bt1 = double_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i = IntegerOfTerm(t2); @@ -941,114 +471,26 @@ p_atan2(Term t1, Term t2 E_ARGS) Float dbl = FloatOfTerm(t2); RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl)); } - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; + case db_ref_e: + RERROR(); } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - RFLOAT(atan2(v1.Int,v2.Int)); - case double_e: - /* integer, double */ - RFLOAT(atan2(v1.Int,v2.dbl)); -#ifdef USE_GMP - case big_int_e: - /* integer, double */ - { - Float dbl = atan2(v1.Int,mpz_get_d(v2.big)); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: - switch (bt2) { - case long_int_e: - /* float / integer */ - RFLOAT(atan2(v1.dbl,v2.Int)); - case double_e: - /* float / float */ - RFLOAT(atan2(v1.dbl,v2.dbl)); -#ifdef USE_GMP - case big_int_e: - /* float / float */ - { - Float dbl = atan2(v1.dbl,mpz_get_d(v2.big)); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* error */ - RERROR(); - } -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - { - Float dbl = atan2(mpz_get_d(v1.big),v2.Int); - mpz_clear(v1.big); - RFLOAT(dbl); - } - case double_e: - /* big / float */ - { - Float dbl = atan2(mpz_get_d(v1.big),v2.dbl); - mpz_clear(v1.big); - RFLOAT(dbl); - } - case big_int_e: - /* big / big */ - { - Float dbl = atan2(mpz_get_d(v1.big),mpz_get_d(v2.big)); - mpz_clear(v1.big); - mpz_clear(v2.big); - RFLOAT(dbl); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + RERROR(); } + /* power: x^y */ -static E_FUNC -p_power(Term t1, Term t2 E_ARGS) +static Term +p_power(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i2 = IntegerOfTerm(t2); @@ -1071,17 +513,12 @@ p_power(Term t1, Term t2 E_ARGS) RFLOAT(pow(i1,f2)); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { @@ -1099,18 +536,13 @@ p_power(Term t1, Term t2 E_ARGS) RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2)))); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.dbl = FloatOfTerm(t1); - bt1 = double_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; -#ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { +#ifdef USE_GMP + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i = IntegerOfTerm(t2); @@ -1124,97 +556,14 @@ p_power(Term t1, Term t2 E_ARGS) Float dbl = FloatOfTerm(t2); RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl)); } - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; + case db_ref_e: + RERROR(); } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - RFLOAT(pow(v1.Int,v2.Int)); - case double_e: - /* integer, double */ - RFLOAT(pow(v1.Int,v2.dbl)); -#ifdef USE_GMP - case big_int_e: - /* integer, double */ - { - Float dbl = pow(v1.Int,mpz_get_d(v2.big)); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: - switch (bt2) { - case long_int_e: - /* float / integer */ - RFLOAT(pow(v1.dbl,v2.Int)); - case double_e: - /* float / float */ - RFLOAT(pow(v1.dbl,v2.dbl)); -#ifdef USE_GMP - case big_int_e: - /* float / float */ - { - Float dbl = pow(v1.dbl,mpz_get_d(v2.big)); - mpz_clear(v2.big); - RFLOAT(dbl); - } -#endif - default: - /* error */ - RERROR(); - } -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - { - Float dbl = pow(mpz_get_d(v1.big),v2.Int); - mpz_clear(v1.big); - RFLOAT(dbl); - } - case double_e: - /* big / float */ - { - Float dbl = pow(mpz_get_d(v1.big),v2.dbl); - mpz_clear(v1.big); - RFLOAT(dbl); - } - case big_int_e: - /* big / big */ - { - Float dbl = pow(mpz_get_d(v1.big),mpz_get_d(v2.big)); - mpz_clear(v1.big); - mpz_clear(v2.big); - RFLOAT(dbl); - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + RERROR(); } static Int @@ -1230,9 +579,9 @@ gcd(Int m11,Int m21) k=m11/m21; m11 -= k*m21; m12 -= k*m22; } if (m11<0 || m21<0) { /* overflow? */ -/* Oflow = 1; */ + /* Oflow = 1; */ Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), - "gcd/2 with %d and %d", m11, m21); + "gcd/2 with %d and %d", m11, m21); P = (yamop *)FAILCODE; return(1); } @@ -1252,9 +601,9 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */ k=m11/m21; m11 -= k*m21; m12 -= k*m22; } if (m11<0 || m21<0) { /* overflow? */ -/* Oflow = 1; */ + /* Oflow = 1; */ Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, MkIntegerTerm(m11), - "gcdmult/2 with %d and %d", m11, m21); + "gcdmult/2 with %d and %d", m11, m21); P = (yamop *)FAILCODE; return(1); } @@ -1269,18 +618,12 @@ Int gcdmult(Int m11,Int m21,Int *pm11) /* *pm11 gets multiplier of m11 */ /* module gcd */ -static E_FUNC -p_gcd(Term t1, Term t2 E_ARGS) +static Term +p_gcd(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* two integers */ { @@ -1310,11 +653,8 @@ p_gcd(Term t1, Term t2 E_ARGS) } } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: @@ -1323,9 +663,7 @@ p_gcd(Term t1, Term t2 E_ARGS) RERROR(); #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* modulo between bignum and integer */ { @@ -1342,138 +680,36 @@ p_gcd(Term t1, Term t2 E_ARGS) case big_int_e: /* two bignums */ { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t1)); - mpz_gcd(new, new, Yap_BigIntOfTerm(t2)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t1)); + mpz_gcd(&new, &new, Yap_BigIntOfTerm(t2)); + RBIG(&new); } case double_e: Yap_Error(TYPE_ERROR_INTEGER, t2, "gcd/2"); /* make GCC happy */ P = (yamop *)FAILCODE; RERROR(); - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); - } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - { - Int i1 = v1.Int, i2 = v2.Int; - i1 = (i1 >= 0 ? i1 : -i1); - i2 = (i2 >= 0 ? i2 : -i2); - - RINT(gcd(i1,i2)); - } - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - { - if (v1.Int > 0) { - Int i = mpz_gcd_ui(NULL,v2.big,v1.Int); - mpz_clear(v2.big); - RINT(i); - } else if (v1.Int == 0) { - mpz_clear(v2.big); - RINT(0); - } else { - Int i = mpz_gcd_ui(NULL,v2.big,-v1.Int); - mpz_clear(v2.big); - RINT(i); - } - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: -#if USE_GMP - if (bt2 == big_int_e) - mpz_clear(v2.big); -#endif - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "gcd/2"); - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - /* big gcd integer */ - { - if (v2.Int > 0) { - Int i = mpz_gcd_ui(NULL,v1.big,v2.Int); - mpz_clear(v1.big); - RINT(i); - } else if (v2.Int == 0) { - mpz_clear(v1.big); - RINT(0); - } else { - Int i = mpz_gcd_ui(NULL,v1.big,-v2.Int); - mpz_clear(v1.big); - RINT(i); - } - } - case double_e: - /* big // float */ - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "gcd/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - case big_int_e: - if (v2.Int > 0) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - mpz_gcd(new, new, v2.big); - mpz_clear(v2.big); - RBIG(new); - } - default: - /* error */ + case db_ref_e: RERROR(); } #endif - default: - /* error */ + case db_ref_e: RERROR(); } + RERROR(); } /* minimum: min(x,y) */ -static E_FUNC -p_min(Term t1, Term t2 E_ARGS) +static Term +p_min(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i1 = IntegerOfTerm(t1); @@ -1497,25 +733,20 @@ p_min(Term t1, Term t2 E_ARGS) MP_INT *b = Yap_BigIntOfTerm(t2); if (mpz_cmp_si(b,i) < 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b); - RBIG(new); + mpz_init_set(&new, b); + RBIG(&new); } RINT(i); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { @@ -1543,35 +774,30 @@ p_min(Term t1, Term t2 E_ARGS) if (fl1 <= fl2) { RFLOAT(fl1); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t2)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t2)); + RBIG(&new); } } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.dbl = FloatOfTerm(t1); - bt1 = double_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i = IntegerOfTerm(t2); MP_INT *b = Yap_BigIntOfTerm(t1); if (mpz_cmp_si(b,i) < 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b); - RBIG(new); + mpz_init_set(&new, b); + RBIG(&new); } RINT(i); } @@ -1582,15 +808,15 @@ p_min(Term t1, Term t2 E_ARGS) MP_INT *b2 = Yap_BigIntOfTerm(t2); if (mpz_cmp(b1,b2) < 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b1); - RBIG(new); + mpz_init_set(&new, b1); + RBIG(&new); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b2); - RBIG(new); + mpz_init_set(&new, b2); + RBIG(&new); } } case double_e: @@ -1600,163 +826,31 @@ p_min(Term t1, Term t2 E_ARGS) if (fl1 <= fl2) { RFLOAT(fl1); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t1)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t1)); + RBIG(&new); } } - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; + case db_ref_e: + RERROR(); } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - RINT((v1.Int < v2.Int ? v1.Int : v2.Int)); - case double_e: - /* integer, double */ - { - if (v1.Int <= v2.dbl) { - RINT(v1.Int); - } - RFLOAT(v2.dbl); - } -#ifdef USE_GMP - case big_int_e: - /* integer, double */ - { - if (mpz_cmp_si(v2.big,v1.Int) < 0) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v2.big); - RBIG(new); - } - mpz_clear(v2.big); - RINT(v1.Int); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: - switch (bt2) { - case long_int_e: - /* float / integer */ - { - if (v2.Int <= v1.dbl) { - RINT(v2.Int); - } - RFLOAT(v1.dbl); - } - case double_e: - /* float / float */ - { - if (v2.dbl <= v1.dbl) { - RFLOAT(v2.dbl); - } - RFLOAT(v1.dbl); - } -#ifdef USE_GMP - case big_int_e: - /* float / big */ - { - if (mpz_get_d(v2.big) <= v1.dbl) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v2.big); - RBIG(new); - } - mpz_clear(v2.big); - RFLOAT(v1.dbl); - } -#endif - default: - /* error */ - RERROR(); - } -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - /* integer, double */ - { - if (mpz_cmp_si(v1.big,v2.Int) < 0) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - RBIG(new); - } - mpz_clear(v1.big); - RINT(v2.Int); - } - case double_e: - /* big / float */ - { - if (mpz_get_d(v1.big) <= v2.dbl) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - RBIG(new); - } - mpz_clear(v1.big); - RFLOAT(v2.dbl); - } - case big_int_e: - /* big / big */ - { - MP_INT *new = TMP_BIG(); - if (mpz_cmp(v1.big,v2.big) < 0) { - - MPZ_SET(new, v1.big); - mpz_clear(v2.big); - RBIG(new); - } else { - MPZ_SET(new, v2.big); - mpz_clear(v1.big); - RBIG(new); - } - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + RERROR(); } /* maximum: max(x,y) */ -static E_FUNC -p_max(Term t1, Term t2 E_ARGS) +static Term +p_max(Term t1, Term t2) { - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i1 = IntegerOfTerm(t1); @@ -1780,25 +874,20 @@ p_max(Term t1, Term t2 E_ARGS) MP_INT *b = Yap_BigIntOfTerm(t2); if (mpz_cmp_si(b,i) > 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b); - RBIG(new); + mpz_init_set(&new, b); + RBIG(&new); } RINT(i); } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* float / integer */ { @@ -1826,35 +915,30 @@ p_max(Term t1, Term t2 E_ARGS) if (fl1 >= fl2) { RFLOAT(fl1); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t2)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t2)); + RBIG(&new); } } #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.dbl = FloatOfTerm(t1); - bt1 = double_e; - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } break; #ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: { Int i = IntegerOfTerm(t2); MP_INT *b = Yap_BigIntOfTerm(t1); if (mpz_cmp_si(b,i) > 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b); - RBIG(new); + mpz_init_set(&new, b); + RBIG(&new); } RINT(i); } @@ -1865,15 +949,15 @@ p_max(Term t1, Term t2 E_ARGS) MP_INT *b2 = Yap_BigIntOfTerm(t2); if (mpz_cmp(b1,b2) > 0) { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b1); - RBIG(new); + mpz_init_set(&new, b1); + RBIG(&new); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, b1); - RBIG(new); + mpz_init_set(&new, b1); + RBIG(&new); } } case double_e: @@ -1883,220 +967,131 @@ p_max(Term t1, Term t2 E_ARGS) if (fl1 >= fl2) { RFLOAT(fl1); } else { - MP_INT *new = TMP_BIG(); + MP_INT new; - mpz_init_set(new, Yap_BigIntOfTerm(t1)); - RBIG(new); + mpz_init_set(&new, Yap_BigIntOfTerm(t1)); + RBIG(&new); } } - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = Yap_Eval(t2, &v2); - break; + case db_ref_e: + RERROR(); } #endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = Yap_Eval(t1, &v1); - /* don't know anything about second */ - bt2 = Yap_Eval(t2, &v2); + case db_ref_e: + RERROR(); } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - /* two integers */ - RINT((v1.Int > v2.Int ? v1.Int : v2.Int)); - case double_e: - /* integer, double */ - { - if (v1.Int >= v2.dbl) { - RINT(v1.Int); - } - RFLOAT(v2.dbl); - } -#ifdef USE_GMP - case big_int_e: - /* integer, double */ - { - if (mpz_cmp_si(v2.big,v1.Int) > 0) { - MP_INT *new = TMP_BIG(); + RERROR(); +} - MPZ_SET(new, v2.big); - RBIG(new); - } - mpz_clear(v2.big); - RINT(v1.Int); - } -#endif - default: - /* Yap_Error */ - RERROR(); - } - case double_e: - switch (bt2) { - case long_int_e: - /* float / integer */ - { - if (v2.Int >= v1.dbl) { - RINT(v2.Int); - } - RFLOAT(v1.dbl); - } - case double_e: - /* float / float */ - { - if (v2.dbl >= v1.dbl) { - RFLOAT(v2.dbl); - } - RFLOAT(v1.dbl); - } -#ifdef USE_GMP - case big_int_e: - /* float / big */ - { - if (mpz_get_d(v2.big) >= v1.dbl) { - MP_INT *new = TMP_BIG(); +static Term +eval2(Int fi, Term t1, Term t2) { + arith2_op f = fi; + switch (f) { + case op_plus: + return p_plus(t1, t2); + case op_minus: + return p_minus(t1, t2); + case op_times: + return p_times(t1, t2); + case op_div: + return p_div(t1, t2); + case op_and: + return p_and(t1, t2); + case op_or: + return p_or(t1, t2); + case op_sll: + return p_sll(t1, t2); + case op_slr: + return p_slr(t1, t2); + case op_mod: + return p_mod(t1, t2); + case op_rem: + return p_rem(t1, t2); + case op_fdiv: + return p_fdiv(t1, t2); + case op_xor: + return p_xor(t1, t2); + case op_atan2: + return p_atan2(t1, t2); + case op_power: + return p_power(t1, t2); + case op_gcd: + return p_gcd(t1, t2); + case op_min: + return p_min(t1, t2); + case op_max: + return p_max(t1, t2); + } + RERROR(); +} - MPZ_SET(new, v2.big); - RBIG(new); - } - mpz_clear(v2.big); - RFLOAT(v1.dbl); - } -#endif - default: - /* error */ - RERROR(); - } -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - /* integer, double */ - { - if (mpz_cmp_si(v1.big,v2.Int) > 0) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - RBIG(new); - } - mpz_clear(v1.big); - RINT(v2.Int); - } - case double_e: - /* big / float */ - { - if (mpz_get_d(v1.big) >= v2.dbl) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - RBIG(new); - } - mpz_clear(v1.big); - RFLOAT(v2.dbl); - } - case big_int_e: - /* big / big */ - { - if (mpz_cmp(v1.big,v2.big) > 0) { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v1.big); - mpz_clear(v2.big); - RBIG(new); - } else { - MP_INT *new = TMP_BIG(); - - MPZ_SET(new, v2.big); - mpz_clear(v1.big); - RBIG(new); - } - } - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } +Term Yap_eval_binary(Int f, Term t1, Term t2) +{ + return eval2(f,t1,t2); } static InitBinEntry InitBinTab[] = { - {"+", p_plus}, - {"-", p_minus}, - {"*", p_times}, - {"/", p_fdiv}, - {"mod", p_mod}, - {"rem", p_rem}, - {"//", p_div}, - {"<<", p_sll}, - {">>", p_slr}, - {"/\\", p_and}, - {"\\/", p_or}, - {"#", p_xor}, - {"atan2", p_atan2}, + {"+", op_plus}, + {"-", op_minus}, + {"*", op_times}, + {"/", op_fdiv}, + {"mod", op_mod}, + {"rem", op_rem}, + {"//", op_div}, + {"<<", op_sll}, + {">>", op_slr}, + {"/\\", op_and}, + {"\\/", op_or}, + {"#", op_xor}, + {"atan2", op_atan2}, /* C-Prolog exponentiation */ - {"^", p_power}, + {"^", op_power}, /* ISO-Prolog exponentiation */ - {"**", p_power}, + {"**", op_power}, /* Quintus exponentiation */ - {"exp", p_power}, - {"gcd", p_gcd}, - {"min", p_min}, - {"max", p_max} + {"exp", op_power}, + {"gcd", op_gcd}, + {"min", op_min}, + {"max", op_max} }; static Int p_binary_is(void) { /* X is Y */ Term t = Deref(ARG2); - union arith_ret res; - blob_type f; + Term t1, t2; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } + t1 = Yap_Eval(Deref(ARG3)); + if (t1 == 0L) + return FALSE; + t2 = Yap_Eval(Deref(ARG4)); + if (t2 == 0L) + return FALSE; if (IsIntTerm(t)) { - blob_type f = InitBinTab[IntOfTerm(t)].f(Deref(ARG3),Deref(ARG4),&res); - Term out = EvalToTerm(f,&res); - if (out == TermNil) { - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t, "is/2"); - return FALSE; - } - return (Yap_unify_constant(ARG1,out)); + return Yap_unify_constant(ARG1,eval2(IntOfTerm(t), t1, t2)); } if (IsAtomTerm(t)) { Atom name = AtomOfTerm(t); ExpEntry *p; - Term out; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { Term ti[2]; /* error */ ti[0] = t; - ti[1] = MkIntTerm(2); + ti[1] = MkIntTerm(1); t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti); Yap_Error(TYPE_ERROR_EVALUABLE, t, - "functor %s/%d for arithmetic expression", - RepAtom(name)->StrOfAE,2); + "functor %s/%d for arithmetic expression", + RepAtom(name)->StrOfAE,2); P = (yamop *)FAILCODE; return(FALSE); } - f = p->FOfEE.binary(Deref(ARG3),Deref(ARG4),&res); - out = EvalToTerm(f,&res); - if (out == TermNil) { - Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, t, "is/2"); - return FALSE; - } - return Yap_unify_constant(ARG1,out); + return Yap_unify_constant(ARG1,eval2(p->FOfEE, t1, t2)); } return(FALSE); } @@ -2118,7 +1113,7 @@ Yap_InitBinaryExps(void) p->KindOfPE = ExpProperty; p->ArityOfEE = 2; p->ENoOfEE = 2; - p->FOfEE.binary = InitBinTab[i].f; + p->FOfEE = InitBinTab[i].f; p->NextOfPE = ae->PropsOfAE; ae->PropsOfAE = AbsExpProp(p); WRITE_UNLOCK(ae->ARWLock); @@ -2130,20 +1125,6 @@ Yap_InitBinaryExps(void) int Yap_ReInitBinaryExps(void) { - unsigned int i; - Prop p; - - for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) { - AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitBinTab[i].OpName)); - - WRITE_LOCK(ae->ARWLock); - if ((p = Yap_GetExpPropHavingLock(ae, 2)) == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return(FALSE); - } - RepExpProp(p)->FOfEE.binary = InitBinTab[i].f; - WRITE_UNLOCK(ae->ARWLock); - } return(TRUE); } diff --git a/C/arrays.c b/C/arrays.c index 3c8fa1a29..4f3b4b46e 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -367,11 +367,9 @@ p_access_array(void) Int indx; if (IsNonVarTerm(ti)) { - union arith_ret v; - if (IsIntTerm(ti)) - indx = IntOfTerm(ti); - else if (Yap_Eval(ti, &v) == long_int_e) - indx = v.Int; + Term nti; + if (IsIntegerTerm(nti=Yap_Eval(ti))) + indx = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,ti,"access_array"); return (FALSE); @@ -413,13 +411,11 @@ p_array_arg(void) register Int indx; if (IsNonVarTerm(ti)) { - union arith_ret v; - if (IsIntTerm(ti)) - indx = IntOfTerm(ti); - else if (Yap_Eval(ti, &v) == long_int_e) - indx = v.Int; + Term nti; + if (IsIntegerTerm(nti=Yap_Eval(ti))) + indx = IntegerOfTerm(nti); else { - Yap_Error(TYPE_ERROR_INTEGER,ti,"array_arg"); + Yap_Error(TYPE_ERROR_INTEGER,ti,"access_array"); return (FALSE); } } @@ -793,11 +789,13 @@ p_create_array(void) ti = Deref(ARG2); t = Deref(ARG1); { - union arith_ret v; - if (IsIntTerm(ti)) - size = IntOfTerm(ti); - else if (Yap_Eval(ti, &v) == long_int_e) - size = v.Int; + Term nti; + if (IsVarTerm(ti)) { + Yap_Error(INSTANTIATION_ERROR,ti,"create_array"); + return (FALSE); + } + if (IsIntegerTerm(nti=Yap_Eval(ti))) + size = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,ti,"create_array"); return (FALSE); @@ -897,13 +895,11 @@ p_create_static_array(void) if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR,ti,"create static array"); return (FALSE); - } else if (IsIntTerm(ti)) - size = IntOfTerm(ti); - else { - union arith_ret v; - if (Yap_Eval(ti, &v) == long_int_e) { - size = v.Int; - } + } else { + Term nti; + + if (IsIntegerTerm(nti=Yap_Eval(ti))) + size = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,ti,"create static array"); return (FALSE); @@ -1059,13 +1055,11 @@ p_resize_static_array(void) if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR,ti,"resize a static array"); return (FALSE); - } else if (IsIntTerm(ti)) - size = IntOfTerm(ti); - else { - union arith_ret v; - if (Yap_Eval(ti, &v) == long_int_e) { - size = v.Int; - } + } else { + Term nti; + + if (IsIntegerTerm(nti=Yap_Eval(ti))) + size = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,ti,"resize a static array"); return (FALSE); @@ -1293,13 +1287,11 @@ p_create_mmapped_array(void) if (IsVarTerm(ti)) { Yap_Error(INSTANTIATION_ERROR,ti,"create_mmapped_array"); return (FALSE); - } else if (IsIntTerm(ti)) - size = IntOfTerm(ti); - else { - union arith_ret v; - if (Yap_Eval(ti, &v) == long_int_e) { - size = v.Int; - } + } else { + Term nti; + + if (IsIntegerTerm(nti=Yap_Eval(ti))) + size = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array"); return (FALSE); @@ -1583,16 +1575,13 @@ p_assign_static(void) t2 = Deref(ARG2); if (IsNonVarTerm(t2)) { - if (IsIntTerm(t2)) - indx = IntOfTerm(t2); - else { - union arith_ret v; - if (Yap_Eval(t2, &v) == long_int_e) { - indx = v.Int; - } else { - Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array"); - return (FALSE); - } + Term nti; + + if (IsIntegerTerm(nti=Yap_Eval(t2))) + indx = IntegerOfTerm(nti); + else { + Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array"); + return (FALSE); } } else { Yap_Error(INSTANTIATION_ERROR,t2,"update_array"); @@ -1680,17 +1669,16 @@ p_assign_static(void) case array_of_ints: { Int i; - union arith_ret v; + Term nti; if (IsVarTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); return FALSE; } - if (IsIntTerm(t3)) - i = IntOfTerm(t3); - else if (Yap_Eval(t3, &v) == long_int_e) - i = v.Int; + + if (IsIntegerTerm(nti=Yap_Eval(t3))) + i = IntegerOfTerm(nti); else { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static"); @@ -1703,17 +1691,15 @@ p_assign_static(void) case array_of_chars: { Int i; - union arith_ret v; + Term nti; if (IsVarTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); return FALSE; } - if (IsIntTerm(t3)) - i = IntOfTerm(t3); - else if (Yap_Eval(t3, &v) == long_int_e) - i = v.Int; + if (IsIntegerTerm(nti=Yap_Eval(t3))) + i = IntegerOfTerm(nti); else { Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static"); return (FALSE); @@ -1730,17 +1716,15 @@ p_assign_static(void) case array_of_uchars: { Int i; - union arith_ret v; + Term nti; if (IsVarTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); return FALSE; } - if (IsIntTerm(t3)) - i = IntOfTerm(t3); - else if (Yap_Eval(t3, &v) == long_int_e) - i = v.Int; + if (IsIntegerTerm(nti=Yap_Eval(t3))) + i = IntegerOfTerm(nti); else { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(TYPE_ERROR_INTEGER,t3,"assign_static"); @@ -1758,17 +1742,17 @@ p_assign_static(void) case array_of_doubles: { Float f; - union arith_ret v; + Term nti; if (IsVarTerm(t3)) { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(INSTANTIATION_ERROR,t3,"assign_static"); return FALSE; } - if (IsFloatTerm(t3)) - f = FloatOfTerm(t3); - else if (Yap_Eval(t3, &v) == double_e) - f = v.dbl; + if (IsFloatTerm(nti=Yap_Eval(t3))) + f = FloatOfTerm(nti); + else if (IsIntegerTerm(nti)) + f = IntegerOfTerm(nti); else { WRITE_UNLOCK(ptr->ArRWLock); Yap_Error(TYPE_ERROR_FLOAT,t3,"assign_static"); @@ -1923,16 +1907,12 @@ p_assign_dynamic(void) t2 = Deref(ARG2); if (IsNonVarTerm(t2)) { - if (IsIntTerm(t2)) - indx = IntOfTerm(t2); - else { - union arith_ret v; - if (Yap_Eval(t2, &v) == long_int_e) { - indx = v.Int; - } else { - Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array"); - return (FALSE); - } + Term nti; + if (IsIntegerTerm(nti=Yap_Eval(t2))) { + indx = IntegerOfTerm(nti); + } else { + Yap_Error(TYPE_ERROR_INTEGER,t2,"update_array"); + return (FALSE); } } else { Yap_Error(INSTANTIATION_ERROR,t2,"update_array"); @@ -2067,16 +2047,12 @@ p_add_to_array_element(void) t2 = Deref(ARG2); if (IsNonVarTerm(t2)) { - if (IsIntTerm(t2)) - indx = IntOfTerm(t2); - else { - union arith_ret v; - if (Yap_Eval(t2, &v) == long_int_e) { - indx = v.Int; - } else { - Yap_Error(TYPE_ERROR_INTEGER,t2,"add_to_array_element"); - return (FALSE); - } + Term nti; + if (IsIntegerTerm(nti=Yap_Eval(t2))) { + indx = IntegerOfTerm(nti); + } else { + Yap_Error(TYPE_ERROR_INTEGER,t2,"add_to_array_element"); + return (FALSE); } } else { Yap_Error(INSTANTIATION_ERROR,t2,"add_to_array_element"); diff --git a/C/cmppreds.c b/C/cmppreds.c index e9302bbc6..ea49542a9 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -534,14 +534,9 @@ flt_cmp(Float dif) } -static Int -p_acomp(void) -{ /* $a_compare(?R,+X,+Y) */ - register blob_type bt1; - Term t1 = Deref(ARG1); - Term t2 = Deref(ARG2); - union arith_ret v1; - +static inline int +a_cmp(Term t1, Term t2) +{ if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2"); return(FALSE); @@ -556,73 +551,81 @@ p_acomp(void) if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) { return(int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2))); } - bt1 = Yap_Eval(t1, &v1); - switch (bt1) { - case long_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + t1 = Yap_Eval(t1); + if (IsIntegerTerm(t1)) { + t2 = Yap_Eval(t2); + Int i1 = IntegerOfTerm(t1); - switch (bt2) { - case long_int_e: - return(int_cmp(v1.Int-v2.Int)); - case double_e: - return(flt_cmp(v1.Int-v2.dbl)); + if (IsIntegerTerm(t2)) { + Int i2 = IntegerOfTerm(t2); + return(int_cmp(i1-i2)); + } else if (IsFloatTerm(t2)) { + Float f2 = FloatOfTerm(2); + return(flt_cmp(i1-f2)); + } else if (IsBigIntTerm(t2)) { #ifdef USE_GMP - case big_int_e: - return(int_cmp(-mpz_cmp_si(v2.big,v1.Int))); + MP_INT *b2 = Yap_BigIntOfTerm(t2); + return(int_cmp(-mpz_cmp_si(b2,i1))); #endif - default: - return(FALSE); - } + } else { + return(FALSE); } - case double_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + } else if (IsFloatTerm(t1)) { + t2 = Yap_Eval(t2); + Float f1 = FloatOfTerm(t1); - switch (bt2) { - case long_int_e: - return(flt_cmp(v1.dbl-v2.Int)); - case double_e: - return(flt_cmp(v1.dbl-v2.dbl)); + if (IsIntegerTerm(t2)) { + Int i2 = IntegerOfTerm(t2); + return(flt_cmp(f1-i2)); + } else if (IsFloatTerm(t2)) { + Float f2 = FloatOfTerm(2); + return(flt_cmp(f1-f2)); + } else if (IsBigIntTerm(t2)) { #ifdef USE_GMP - case big_int_e: - return(flt_cmp(v1.dbl-mpz_get_d(v2.big))); + MP_INT *b2 = Yap_BigIntOfTerm(t2); + return(flt_cmp(f1-mpz_get_d(b2))); #endif - default: - return(FALSE); - } + } else { + return(FALSE); } + } else if (IsBigIntTerm(t1)) { #ifdef USE_GMP - case big_int_e: { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + t2 = Yap_Eval(t2); + MP_INT *b1 = Yap_BigIntOfTerm(t1); - switch (bt2) { - case long_int_e: - return(int_cmp(mpz_cmp_si(v1.big,v2.Int))); - case double_e: - return(flt_cmp(mpz_get_d(v1.big)-v2.dbl)); - case big_int_e: - return(int_cmp(mpz_cmp(v1.big,v2.big))); - default: - return(FALSE); - } + if (IsIntegerTerm(t2)) { + Int i2 = IntegerOfTerm(t2); + return(int_cmp(mpz_cmp_si(b1,i2))); + } else if (IsFloatTerm(t2)) { + Float f2 = FloatOfTerm(2); + return(flt_cmp(mpz_get_d(b1)-f2)); + } else if (IsBigIntTerm(t2)) { + MP_INT *b2 = Yap_BigIntOfTerm(2); + return(int_cmp(mpz_cmp(b1,b2))); + } else { + return(FALSE); + } } #endif - default: + } else { return(FALSE); } } + +static Int +p_acomp(void) +{ /* $a_compare(?R,+X,+Y) */ + Term t1 = Deref(ARG1); + Term t2 = Deref(ARG2); + + return a_cmp(t1, t2); +} + static Int a_eq(Term t1, Term t2) { /* A =:= B */ - blob_type bt1; - union arith_ret v1; - if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2"); return(FALSE); @@ -635,460 +638,74 @@ a_eq(Term t1, Term t2) return (FloatOfTerm(t1) == FloatOfTerm(t2)); if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) return (IntegerOfTerm(t1) == IntegerOfTerm(t2)); - bt1 = Yap_Eval(t1, &v1); - switch (bt1) { - case long_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + t1 = Yap_Eval(t1); + if (IsIntegerTerm(t1)) { + t2 = Yap_Eval(t2); + Int i1 = IntegerOfTerm(t1); - switch (bt2) { - case long_int_e: - return(v1.Int == v2.Int); - case double_e: - return(v1.Int == v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(-mpz_cmp_si(v2.big,v1.Int) == 0); -#endif - default: - return(FALSE); - } + if (IsIntegerTerm(t2)) { + Int i2 = IntegerOfTerm(t2); + return(i1==i2); + } else { + return FALSE; } - case double_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + } else if (IsFloatTerm(t1)) { + t2 = Yap_Eval(t2); + Float f1 = FloatOfTerm(t1); - switch (bt2) { - case long_int_e: - return(v1.dbl == v2.Int); - case double_e: - return(v1.dbl == v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(v1.dbl == mpz_get_d(v2.big)); -#endif - default: - return(FALSE); - } + if (IsFloatTerm(t2)) { + Float f2 = FloatOfTerm(2); + return(f1 == f2); + } else { + return FALSE; } + } else if (IsBigIntTerm(t1)) { #ifdef USE_GMP - case big_int_e: { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); + t2 = Yap_Eval(t2); + MP_INT *b1 = Yap_BigIntOfTerm(t1); - switch (bt2) { - case long_int_e: - return(mpz_cmp_si(v1.big,v2.Int) == 0); - case double_e: - return(mpz_get_d(v1.big) == v2.dbl); - case big_int_e: - return(mpz_cmp(v1.big,v2.big) == 0); - default: - return(FALSE); - } + if (IsBigIntTerm(t2)) { + MP_INT *b2 = Yap_BigIntOfTerm(2); + return(mpz_cmp(b1,b2) == 0); + } else { + return(FALSE); + } } #endif - default: + } else { return(FALSE); } } static Int a_dif(Term t1, Term t2) -{ /* A =\\= B */ - blob_type bt1; - union arith_ret v1; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "=\\=/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "=\\=/2"); - return(FALSE); - } - if (IsFloatTerm(t1) && IsFloatTerm(t2)) - return (FloatOfTerm(t1) != FloatOfTerm(t2)); - if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) - return (IntegerOfTerm(t1) != IntegerOfTerm(t2)); - bt1 = Yap_Eval(t1, &v1); - switch (bt1) { - case long_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.Int != v2.Int); - case double_e: - return(v1.Int != v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(-mpz_cmp_si(v2.big,v1.Int) != 0); -#endif - default: - return(FALSE); - } - } - case double_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.dbl != v2.Int); - case double_e: - return(v1.dbl != v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(v1.dbl != mpz_get_d(v2.big)); -#endif - default: - return(FALSE); - } - } -#ifdef USE_GMP - case big_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(mpz_cmp_si(v1.big,v2.Int) != 0); - case double_e: - return(mpz_get_d(v1.big) != v2.dbl); - case big_int_e: - return(mpz_cmp(v1.big,v2.big) != 0); - default: - return(FALSE); - } - } -#endif - default: - return(FALSE); - } +{ + return !a_eq(t1,t2); } static Int a_gt(Term t1, Term t2) { /* A > B */ - blob_type bt1; - union arith_ret v1; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, ">/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, ">/2"); - return(FALSE); - } - if (IsFloatTerm(t1) && IsFloatTerm(t2)) - return (FloatOfTerm(t1) > FloatOfTerm(t2)); - if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) - return (IntegerOfTerm(t1) > IntegerOfTerm(t2)); - bt1 = Yap_Eval(t1, &v1); - switch (bt1) { - case long_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.Int > v2.Int); - case double_e: - return(v1.Int > v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(-mpz_cmp_si(v2.big,v1.Int) > 0); -#endif - default: - return(FALSE); - } - } - case double_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.dbl > v2.Int); - case double_e: - return(v1.dbl > v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(v1.dbl > mpz_get_d(v2.big)); -#endif - default: - return(FALSE); - } - } -#ifdef USE_GMP - case big_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(mpz_cmp_si(v1.big,v2.Int) > 0); - case double_e: - return(mpz_get_d(v1.big) > v2.dbl); - case big_int_e: - return(mpz_cmp(v1.big,v2.big) > 0); - default: - return(FALSE); - } - } -#endif - default: - return(FALSE); - } + return a_cmp(t1,t2) > 0; } static Int a_ge(Term t1, Term t2) { /* A >= B */ - blob_type bt1; - union arith_ret v1; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, ">=/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t1, ">=/2"); - return(FALSE); - } - if (IsFloatTerm(t1) && IsFloatTerm(t2)) - return (FloatOfTerm(t1) >= FloatOfTerm(t2)); - if (IsIntegerTerm(t1) && IsIntegerTerm(t2)) - return (IntegerOfTerm(t1) >= IntegerOfTerm(t2)); - bt1 = Yap_Eval(t1, &v1); - switch (bt1) { - case long_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.Int >= v2.Int); - case double_e: - return(v1.Int >= v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(-mpz_cmp_si(v2.big,v1.Int) >= 0); -#endif - default: - return(FALSE); - } - } - case double_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(v1.dbl >= v2.Int); - case double_e: - return(v1.dbl >= v2.dbl); -#ifdef USE_GMP - case big_int_e: - return(v1.dbl >= mpz_get_d(v2.big)); -#endif - default: - return(FALSE); - } - } -#ifdef USE_GMP - case big_int_e: - { - union arith_ret v2; - blob_type bt2 = Yap_Eval(t2, &v2); - - switch (bt2) { - case long_int_e: - return(mpz_cmp_si(v1.big,v2.Int) >= 0); - case double_e: - return(mpz_get_d(v1.big) >= v2.dbl); - case big_int_e: - return(mpz_cmp(v1.big,v2.big) >= 0); - default: - return(FALSE); - } - } -#endif - default: - return(FALSE); - } + return a_cmp(t1,t2) >= 0; } static Int a_lt(Term t1, Term t2) { /* A < B */ - blob_type bt1; - union arith_ret v1; - - if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "big) -#define RBIG(v) return(big_int_e) -#define RINT(v) (o)->Int = v; return(long_int_e) -#define RFLOAT(v) (o)->dbl = v; return(double_e) -#define RERROR() return(db_ref_e) - static Term -EvalToTerm(blob_type bt, union arith_ret *res) -{ - switch (bt) { - case long_int_e: - return MkIntegerTerm(res->Int); - case double_e: - return MkFloatTerm(res->dbl); -#ifdef USE_GMP - case big_int_e: - { - Term t = Yap_MkBigIntTerm(res->big); - mpz_clear(res->big); - return t; - } -#endif - default: - return TermNil; - } -} - -static E_FUNC -Eval(Term t, E_ARGS) +Eval(Term t) { if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic"); P = (yamop *)FAILCODE; - RERROR(); - } - if (IsApplTerm(t)) { - Functor fun = FunctorOfTerm(t); - switch ((CELL)fun) { - case (CELL)FunctorLongInt: - RINT(LongIntOfTerm(t)); - case (CELL)FunctorDouble: - RFLOAT(FloatOfTerm(t)); -#ifdef USE_GMP - case (CELL)FunctorBigInt: - { - MP_INT *new = TMP_BIG(); - mpz_init_set(new, Yap_BigIntOfTerm(t)); - RBIG(new); - } -#endif - default: - { - Int n = ArityOfFunctor(fun); - Atom name = NameOfFunctor(fun); - ExpEntry *p; - - if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { - Term ti[2]; - - /* error */ - ti[0] = t; - ti[1] = MkIntegerTerm(n); - t = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti); - Yap_Error(TYPE_ERROR_EVALUABLE, t, - "functor %s/%d for arithmetic expression", - RepAtom(name)->StrOfAE,n); - P = (yamop *)FAILCODE; - RERROR(); - } - if (n == 1) - return(p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS)); - return(p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS)); - } - } - } else if (IsPairTerm(t)) { - if (TailOfTerm(t) != TermNil) { - Yap_Error(TYPE_ERROR_EVALUABLE, t, - "string must contain a single character to be evaluated as an arithmetic expression"); - P = (yamop *)FAILCODE; - RERROR(); - } - return(Eval(HeadOfTerm(t), USE_E_ARGS)); - } else if (IsIntTerm(t)) { - RINT(IntOfTerm(t)); - } else { - Atom name = AtomOfTerm(t); + return 0L;; + } else if (IsAtomTerm(t)) { ExpEntry *p; + Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { Term ti[2], terror; @@ -133,41 +52,26 @@ Eval(Term t, E_ARGS) "atom %s for arithmetic expression", RepAtom(name)->StrOfAE); P = (yamop *)FAILCODE; - RERROR(); + return 0L; } - return(p->FOfEE.constant(USE_E_ARGS)); - } -} - -E_FUNC -Yap_Eval(Term t, E_ARGS) -{ - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic"); - P = (yamop *)FAILCODE; - RERROR(); - } - if (IsApplTerm(t)) { + return Yap_eval_atom(p->FOfEE); + } else if (IsIntTerm(t)) { + return t; + } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); - switch ((CELL)fun) { case (CELL)FunctorLongInt: - RINT(LongIntOfTerm(t)); case (CELL)FunctorDouble: - RFLOAT(FloatOfTerm(t)); #ifdef USE_GMP case (CELL)FunctorBigInt: - { - MP_INT *new = TMP_BIG(); - mpz_init_set(new, Yap_BigIntOfTerm(t)); - RBIG(new); - } #endif + return t; default: { Int n = ArityOfFunctor(fun); Atom name = NameOfFunctor(fun); ExpEntry *p; + Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { Term ti[2]; @@ -182,45 +86,34 @@ Yap_Eval(Term t, E_ARGS) P = (yamop *)FAILCODE; RERROR(); } - if (n == 1) { - return p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS); - } - return - p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS); + t1 = Eval(ArgOfTerm(1,t)); + if (t1 == 0L) + return FALSE; + if (n == 1) + return Yap_eval_unary(p->FOfEE, t1); + t2 = Eval(ArgOfTerm(2,t)); + if (t2 == 0L) + return FALSE; + return Yap_eval_binary(p->FOfEE,t1,t2); } } - } else if (IsPairTerm(t)) { + } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { Yap_Error(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); P = (yamop *)FAILCODE; - RERROR(); + return 0L; } - return(Eval(HeadOfTerm(t), USE_E_ARGS)); - } else if (IsIntTerm(t)) { - RINT(IntOfTerm(t)); - } else { - Atom name = AtomOfTerm(t); - ExpEntry *p; - - if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { - Term ti[2], terror; - - /* error */ - ti[0] = t; - ti[1] = MkIntegerTerm(0); - /* error */ - terror = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti); - Yap_Error(TYPE_ERROR_EVALUABLE, terror, - "atom %s for arithmetic expression", - RepAtom(name)->StrOfAE); - P = (yamop *)FAILCODE; - RERROR(); - } - return(p->FOfEE.constant(USE_E_ARGS)); + return Eval(HeadOfTerm(t)); } } +Term +Yap_Eval(Term t) +{ + return Eval(t); +} + #ifdef BEAM Int BEAM_is(void); @@ -240,13 +133,10 @@ BEAM_is(void) static Int p_is(void) { /* X is Y */ - union arith_ret res; - blob_type bt; Term out; - bt = Eval(Deref(ARG2), &res); - out = EvalToTerm(bt,&res); - if (out == TermNil) { + out = Eval(Deref(ARG2)); + if (out == 0L) { Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, ARG2, "is/2"); return FALSE; } diff --git a/C/gmp_support.c b/C/gmp_support.c index eafa5c086..dc22f8894 100644 --- a/C/gmp_support.c +++ b/C/gmp_support.c @@ -22,214 +22,250 @@ #if USE_GMP /* add i + j using temporary bigint new */ -MP_INT * -Yap_gmp_add_ints(Int i, Int j, MP_INT *new) +Term +Yap_gmp_add_ints(Int i, Int j) { - mpz_init_set_si(new,i); + MP_INT new; + + mpz_init_set_si(&new,i); if (j > 0) { - mpz_add_ui(new, new, j); + mpz_add_ui(&new, &new, j); } else { if (j-1 > 0) { /* negative overflow */ - mpz_sub_ui(new, new, -(j+1)); - mpz_sub_ui(new, new, 1); + mpz_sub_ui(&new, &new, -(j+1)); + mpz_sub_ui(&new, &new, 1); } else { - mpz_sub_ui(new, new, -j); + mpz_sub_ui(&new, &new, -j); } } - return new; + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_sub_ints(Int i, Int j, MP_INT *new) +Term +Yap_gmp_sub_ints(Int i, Int j) { - mpz_init_set_si(new,i); + MP_INT new; + + mpz_init_set_si(&new,i); if (j > 0) { - mpz_sub_ui(new, new, j); + mpz_sub_ui(&new, &new, j); } else { if (j-1 > 0) { /* negative overflow */ - mpz_add_ui(new, new, -(j+1)); - mpz_add_ui(new, new, 1); + mpz_add_ui(&new, &new, -(j+1)); + mpz_add_ui(&new, &new, 1); } else { - mpz_add_ui(new, new, -j); + mpz_add_ui(&new, &new, -j); } } - return new; + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_mul_ints(Int i, Int j, MP_INT *new) +Term +Yap_gmp_mul_ints(Int i, Int j) { - mpz_init_set_si(new,i); - mpz_mul_si(new, new, j); - return new; + MP_INT new; + + mpz_init_set_si(&new,i); + mpz_mul_si(&new, &new, j); + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_sll_ints(Int i, Int j, MP_INT *new) +Term +Yap_gmp_sll_ints(Int i, Int j) { - mpz_init_set_si(new,i); - mpz_mul_2exp(new, new, j); - return new; + MP_INT new; + + mpz_init_set_si(&new,i); + mpz_mul_2exp(&new, &new, j); + return Yap_MkBigIntTerm(&new); } /* add i + b using temporary bigint new */ -MP_INT * -Yap_gmp_add_int_big(Int i, MP_INT *b, MP_INT *new) +Term +Yap_gmp_add_int_big(Int i, MP_INT *b) { - mpz_init_set_si(new, i); - mpz_add(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_add(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* sub i - b using temporary bigint new */ -MP_INT * -Yap_gmp_sub_int_big(Int i, MP_INT *b, MP_INT *new) +Term +Yap_gmp_sub_int_big(Int i, MP_INT *b) { - mpz_init_set_si(new, i); - mpz_sub(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_sub(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* add i + b using temporary bigint new */ -MP_INT * -Yap_gmp_mul_int_big(Int i, MP_INT *b, MP_INT *new) +Term +Yap_gmp_mul_int_big(Int i, MP_INT *b) { - mpz_init_set_si(new, i); - mpz_mul(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_mul(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* sub i - b using temporary bigint new */ -MP_INT * -Yap_gmp_sub_big_int(MP_INT *b, Int i, MP_INT *new) +Term +Yap_gmp_sub_big_int(MP_INT *b, Int i) { - mpz_init_set_si(new, i); - mpz_neg(new, new); - mpz_add(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_neg(&new, &new); + mpz_add(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* div i / b using temporary bigint new */ -MP_INT * -Yap_gmp_div_big_int(MP_INT *b, Int i, MP_INT *new) +Term +Yap_gmp_div_big_int(MP_INT *b, Int i) { + MP_INT new; - mpz_init_set(new, b); + + mpz_init_set(&new, b); if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) { if (i > 0) { - mpz_fdiv_q_ui(new, new, i); + mpz_fdiv_q_ui(&new, &new, i); } else if (i == 0) { Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); - return NULL; + return 0L; } else { /* we do not handle MIN_INT */ - mpz_fdiv_q_ui(new, new, -i); - mpz_neg(new, new); + mpz_fdiv_q_ui(&new, &new, -i); + mpz_neg(&new, &new); } } else { if (i > 0) { - mpz_tdiv_q_ui(new, new, i); + mpz_tdiv_q_ui(&new, &new, i); } else if (i == 0) { Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, MkIntTerm(0), "// /2"); - return NULL; + return 0L; } else { /* we do not handle MIN_INT */ - mpz_tdiv_q_ui(new, new, -i); - mpz_neg(new, new); + mpz_tdiv_q_ui(&new, &new, -i); + mpz_neg(&new, &new); } } - return new; + return Yap_MkBigIntTerm(&new); } /* sub i - b using temporary bigint new */ -MP_INT * -Yap_gmp_and_int_big(Int i, MP_INT *b, MP_INT *new) +Term +Yap_gmp_and_int_big(Int i, MP_INT *b) { - mpz_init_set_si(new, i); - mpz_and(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_and(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* sub i - b using temporary bigint new */ -MP_INT * -Yap_gmp_ior_int_big(Int i, MP_INT *b, MP_INT *new) +Term +Yap_gmp_ior_int_big(Int i, MP_INT *b) { - mpz_init_set_si(new, i); - mpz_ior(new, new, b); - return new; + MP_INT new; + + mpz_init_set_si(&new, i); + mpz_ior(&new, &new, b); + return Yap_MkBigIntTerm(&new); } /* add i + b using temporary bigint new */ -MP_INT * -Yap_gmp_sll_big_int(MP_INT *b, Int i, MP_INT *new) +Term +Yap_gmp_sll_big_int(MP_INT *b, Int i) { + MP_INT new; + if (i > 0) { - mpz_init_set(new, b); - mpz_mul_2exp(new, new, i); + mpz_init_set(&new, b); + mpz_mul_2exp(&new, &new, i); } else if (i == 0) { - mpz_init_set(new, b); + mpz_init_set(&new, b); } else { - mpz_init_set(new, b); + mpz_init_set(&new, b); if (i == Int_MIN) { - return NULL; + return 0L; } - mpz_tdiv_q_2exp(new, new, -i); + mpz_tdiv_q_2exp(&new, &new, -i); } - return new; + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2) { - mpz_init_set(new, b1); - mpz_add(new, new, b2); - return new; + MP_INT new; + + mpz_init_set(&new, b1); + mpz_add(&new, &new, b2); + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2) { - mpz_init_set(new, b1); - mpz_sub(new, new, b2); - return new; + MP_INT new; + + mpz_init_set(&new, b1); + mpz_sub(&new, &new, b2); + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2) { - mpz_init_set(new, b1); - mpz_mul(new, new, b2); - return new; + MP_INT new; + + mpz_init_set(&new, b1); + mpz_mul(&new, &new, b2); + return Yap_MkBigIntTerm(&new); } /* div i / b using temporary bigint new */ -MP_INT * -Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2) { + MP_INT new; - mpz_init_set(new, b1); + + mpz_init_set(&new, b1); if (yap_flags[INTEGER_ROUNDING_FLAG] == 0) { - mpz_fdiv_q(new, new, b2); + mpz_fdiv_q(&new, &new, b2); } else { - mpz_tdiv_q(new, new, b2); + mpz_tdiv_q(&new, &new, b2); } - return new; + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2) { - mpz_init_set(new, b1); - mpz_and(new, new, b2); - return new; + MP_INT new; + + mpz_init_set(&new, b1); + mpz_and(&new, &new, b2); + return Yap_MkBigIntTerm(&new); } -MP_INT * -Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new) +Term +Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2) { - mpz_init_set(new, b1); - mpz_ior(new, new, b2); - return new; + MP_INT new; + + mpz_init_set(&new, b1); + mpz_ior(&new, &new, b2); + return Yap_MkBigIntTerm(&new); } Float diff --git a/C/mavar.c b/C/mavar.c index 7acf54ab2..af36cae61 100644 --- a/C/mavar.c +++ b/C/mavar.c @@ -49,9 +49,9 @@ p_setarg(void) if (IsIntTerm(ti)) i = IntOfTerm(ti); else { - union arith_ret v; - if (Yap_Eval(ti, &v) == long_int_e) { - i = v.Int; + Term te = Yap_Eval(ti); + if (IsIntegerTerm(te)) { + i = IntegerOfTerm(te); } else { Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3"); return FALSE; diff --git a/C/stdpreds.c b/C/stdpreds.c index e3aee8fbf..936e183f5 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2996,10 +2996,10 @@ p_flags(void) UNLOCK(pe->PELock); return (TRUE); } else if (!IsIntegerTerm(ARG4)) { - union arith_ret v; + Term te = Yap_Eval(ARG4); - if (Yap_Eval(ARG4, &v) == long_int_e) { - newFl = v.Int; + if (IsIntegerTerm(te)) { + newFl = IntegerOfTerm(te); } else { UNLOCK(pe->PELock); Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags"); diff --git a/H/Yatom.h b/H/Yatom.h index 5bd02c5d3..29bdafcc4 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -499,12 +499,7 @@ typedef struct BITS16 ENoOfEE; BITS16 FlagsOfEE; /* operations that implement the expression */ - union - { - blob_type (*constant) (eval_ret); - blob_type (*unary) (Term, eval_ret); - blob_type (*binary) (Term, Term, eval_ret); - } FOfEE; + int FOfEE; } ExpEntry; #if USE_OFFSETS_IN_PROPS diff --git a/H/arith2.h b/H/arith2.h index 895d6bfd6..b140f80f4 100644 --- a/H/arith2.h +++ b/H/arith2.h @@ -1,35 +1,33 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: arithi2.c * -* Last rev: * -* mods: * -* comments: arithmetical expression evaluation * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: arithi2.c * + * Last rev: * + * mods: * + * comments: arithmetical expression evaluation * + * * + *************************************************************************/ /* This file implements fast binary math operations for YAP * */ -inline static E_FUNC -add_int(Int i, Int j E_ARGS) +inline static Term +add_int(Int i, Int j) { Int x = i+j; #if USE_GMP /* Integer overflow, we need to use big integers */ Int overflow = (i & j & ~x) | (~i & ~j & x); if (overflow) { - MP_INT *new = TMP_BIG(); - new = Yap_gmp_add_ints(i, j, new); - RBIG(new); + return(Yap_gmp_add_ints(i, j)); } #endif #ifdef BEAM @@ -40,17 +38,15 @@ add_int(Int i, Int j E_ARGS) #endif } -inline static E_FUNC -sub_int(Int i, Int j E_ARGS) +inline static Term +sub_int(Int i, Int j) { Int x = i-j; #if USE_GMP Int overflow = (i & ~j & ~x) | (~i & j & x); /* Integer overflow, we need to use big integers */ if (overflow) { - MP_INT *new = TMP_BIG(); - new = Yap_gmp_sub_ints(i, j, new); - RBIG(new); + return(Yap_gmp_sub_ints(i, j)); } #endif #ifdef BEAM @@ -61,25 +57,74 @@ sub_int(Int i, Int j E_ARGS) #endif } -/* Extended version with two possibilities: - - both terms do not need evaluation; - - a term needs evaluation; -*/ -static E_FUNC -p_plus(Term t1, Term t2 E_ARGS) -{ - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; +#ifdef __GNUC__ +#ifdef __i386__ +#define DO_MULTI() { Int tmp1; \ + __asm__ ("imull %3\n\t movl $0,%1\n\t jno 0f\n\t movl $1,%1\n\t 0:" \ + : "=a" (z), \ + "=d" (tmp1) \ + : "a" (i1), \ + "rm" (i2) \ + : "cc" ); \ + if (tmp1) goto overflow; \ + } +#define OPTIMIZE_MULTIPLI 1 +#endif +#endif - switch (BlobOfFunctor(f1)) { +#ifndef OPTIMIZE_MULTIPLI +#define DO_MULTI() z = i1*i2; \ + if (i2 && z/i2 != i1) goto overflow +#endif + +inline static Term +times_int(Int i1, Int i2) { +#ifdef USE_GMP + Int z; + DO_MULTI(); + RINT(z); + overflow: + { + return(Yap_gmp_mul_ints(i1, i2)); + } +#else + RINT(i1*i2); +#endif +} + + +#if USE_GMP +static inline Int +sll_ovflw(Int x,Int i) +{ + CELL t = (1<> -i2); } - return do_sll(IntegerOfTerm(t1),IntegerOfTerm(t2) USE_E_ARGS); + return do_sll(IntegerOfTerm(t1),IntegerOfTerm(t2)); case double_e: Yap_Error(TYPE_ERROR_INTEGER, t2, "<>/2"); P = (yamop *)FAILCODE; RERROR(); } - RBIG(new); + return(t); } case big_int_e: Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - RINT(v1.Int >> -v2.Int); - } - return do_sll(v1.Int,v2.Int USE_E_ARGS); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - RBIG(new); - } - case double_e: - /* big << float */ - mpz_clear(v1.big); - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<> - - First argument may be int or bignum; - Second argument may only be an int. -*/ -static E_FUNC -p_slr(Term t1, Term t2 E_ARGS) -{ - Functor f1 = AritFunctorOfTerm(t1), f2; - blob_type bt1, bt2; - union arith_ret v1, v2; - - switch (BlobOfFunctor(f1)) { +static Term +p_slr(Term t1, Term t2) { + switch (ETypeOfTerm(t1)) { case long_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { + switch (ETypeOfTerm(t2)) { case long_int_e: /* two integers */ if (IntegerOfTerm(t2) < 0) { @@ -1338,46 +546,41 @@ p_slr(Term t1, Term t2 E_ARGS) P = (yamop *)FAILCODE; RERROR(); } - return do_sll(IntegerOfTerm(t1), -i2 USE_E_ARGS); + return do_sll(IntegerOfTerm(t1), -i2); } RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2)); case double_e: Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); -#ifdef USE_GMP case big_int_e: +#ifdef USE_GMP Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); #endif - default: - /* we've got a full term, need to evaluate it first */ - v1.Int = IntegerOfTerm(t1); - bt1 = long_int_e; - bt2 = ArithIEval(t2, &v2); + case db_ref_e: + RERROR(); } break; case double_e: Yap_Error(TYPE_ERROR_INTEGER, t1, ">>/2"); P = (yamop *)FAILCODE; RERROR(); -#ifdef USE_GMP case big_int_e: - f2 = AritFunctorOfTerm(t2); - - switch (BlobOfFunctor(f2)) { +#ifdef USE_GMP + switch (ETypeOfTerm(t2)) { case long_int_e: { - MP_INT *new = TMP_BIG(); + Term t; - new = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2), new); - if (!new) { + t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2)); + if (t == 0L) { Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); P = (yamop *)FAILCODE; RERROR(); } - RBIG(new); + return(t); } case big_int_e: Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); @@ -1388,105 +591,13 @@ p_slr(Term t1, Term t2 E_ARGS) /* make GCC happy */ P = (yamop *)FAILCODE; RERROR(); - default: - /* we've got a full term, need to evaluate it first */ - mpz_init_set(v1.big,Yap_BigIntOfTerm(t1)); - bt1 = big_int_e; - bt2 = ArithIEval(t2, &v2); - break; - } -#endif - default: - /* we've got a full term, need to evaluate it first */ - bt1 = ArithIEval(t1, &v1); - /* don't know anything about second */ - bt2 = ArithIEval(t2, &v2); - } - /* second case, no need no evaluation */ - switch (bt1) { - case long_int_e: - switch (bt2) { - case long_int_e: - if (v2.Int < 0) { - if (v2.Int == Int_MIN) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - return do_sll(v1.Int, -v2.Int USE_E_ARGS); - } - RINT(v1.Int >> v2.Int); - case double_e: - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); -#ifdef USE_GMP - case big_int_e: - mpz_clear(v2.big); - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); - RERROR(); -#endif - default: - /* Yap_Error */ + case db_ref_e: RERROR(); } - case double_e: -#if USE_GMP - if (bt2 == big_int_e) - mpz_clear(v2.big); #endif - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), ">>/2"); - P = (yamop *)FAILCODE; + case db_ref_e: RERROR(); -#ifdef USE_GMP - case big_int_e: - switch (bt2) { - case long_int_e: - /* big >> int */ - { - MP_INT *new = TMP_BIG(); - - new = Yap_gmp_sll_big_int(v1.big, -v2.Int, new); - if (!new) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - MPZ_SET(new, v1.big); - if (v2.Int > 0) { - mpz_tdiv_q_2exp(new, new, v2.Int); - } else if (v2.Int < 0) { - if (v2.Int == Int_MIN) { - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); - } - mpz_mul_2exp(new, v1.big, -v2.Int); - } - RBIG(new); - } - case double_e: - /* big >> float */ - mpz_clear(v1.big); - Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2"); - /* make GCC happy */ - P = (yamop *)FAILCODE; - RERROR(); - case big_int_e: - /* big >> big */ - mpz_clear(v1.big); - mpz_clear(v2.big); - Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2"); - P = (yamop *)FAILCODE; - RERROR(); - default: - /* error */ - RERROR(); - } -#endif - default: - /* error */ - RERROR(); - } + } + RERROR(); } + diff --git a/H/eval.h b/H/eval.h index 29303071d..95b8f8477 100644 --- a/H/eval.h +++ b/H/eval.h @@ -39,23 +39,83 @@ #define Int_MIN (-Int_MAX-(CELL)1) #endif -typedef union arith_ret { - Int Int; - Float dbl; -#ifdef USE_GMP - mpz_t big; -#endif -} *arith_retptr; +typedef enum { + op_pi, + op_e, + op_inf, + op_nan, + op_random, + op_cputime, + op_heapused, + op_localsp, + op_globalsp, + op_b, + op_env, + op_tr, + op_stackfree +} arith0_op; -/* -#define RINT(v) return(MkIntegerTerm(v)) -#define RFLOAT(v) return(MkFloatTerm(v)) -#define RBIG(v) return(Yap_MkBigIntTerm(v)) -#define RBIG_FL(v) return(Yap_MkBigIntTerm((MP_INT *)(Int)v)) -#define RERROR() return(MkIntTerm(0)) -*/ +typedef enum { + op_uplus, + op_uminus, + op_unot, + op_exp, + op_log, + op_log10, + op_sqrt, + op_sin, + op_cos, + op_tan, + op_sinh, + op_cosh, + op_tanh, + op_asin, + op_acos, + op_atan, + op_asinh, + op_acosh, + op_atanh, + op_floor, + op_ceiling, + op_round, + op_truncate, + op_integer, + op_float, + op_abs, + op_msb, + op_ffracp, + op_fintp, + op_sign, + op_lgamma, + op_random1 +} arith1_op; -Functor STD_PROTO(EvalArg,(Term,arith_retptr)); +typedef enum { + op_plus, + op_minus, + op_times, + op_fdiv, + op_mod, + op_rem, + op_div, + op_sll, + op_slr, + op_and, + op_or, + op_xor, + op_atan2, + /* C-Prolog exponentiation */ + op_power, + /* ISO-Prolog exponentiation */ + /* op_power, */ + /* Quintus exponentiation */ + /* op_power, */ + op_gcd, + op_min, + op_max +} arith2_op; + +Functor STD_PROTO(EvalArg,(Term)); /* Needed to handle numbers: these two macros are fundamental in the integer/float conversions */ @@ -98,27 +158,53 @@ int STD_PROTO(Yap_ReInitConstExps,(void)); int STD_PROTO(Yap_ReInitUnaryExps,(void)); int STD_PROTO(Yap_ReInitBinaryExps,(void)); -blob_type STD_PROTO(Yap_Eval,(Term, union arith_ret *)); +Term STD_PROTO(Yap_eval_atom,(Int)); +Term STD_PROTO(Yap_eval_unary,(Int,Term)); +Term STD_PROTO(Yap_eval_binary,(Int,Term,Term)); + +blob_type STD_PROTO(Yap_Eval,(Term)); + +#define RINT(v) return(MkIntegerTerm(v)) +#define RFLOAT(v) return(MkFloatTerm(v)) +#define RBIG(v) return(Yap_MkBigIntTerm(v)) +#define RERROR() return(0L) + +static inline blob_type +ETypeOfTerm(Term t) +{ + if (IsIntTerm(t)) + return long_int_e; + if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorDouble) + return double_e; + if (f == FunctorLongInt) + return long_int_e; + if (f == FunctorBigInt) + return big_int_e; + } + return db_ref_e; +} #if USE_GMP -MP_INT *STD_PROTO(Yap_gmp_add_ints,(Int, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sub_ints,(Int, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_mul_ints,(Int, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sll_ints,(Int, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *, MP_INT *)); -MP_INT *STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_add_ints,(Int, Int)); +Term STD_PROTO(Yap_gmp_sub_ints,(Int, Int)); +Term STD_PROTO(Yap_gmp_mul_ints,(Int, Int)); +Term STD_PROTO(Yap_gmp_sll_ints,(Int, Int)); +Term STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *)); +Term STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *)); +Term STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int)); +Term STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *)); +Term STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int)); +Term STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *)); +Term STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *)); +Term STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int)); +Term STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *)); +Term STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *)); diff --git a/pl/arith.yap b/pl/arith.yap index 5e1a759bd..f70c85274 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -79,6 +79,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]). '$clean_cuts'(NG0, NG), '$do_c_built_in'(A,M,NA). '$do_c_built_in'('C'(A,B,C), _, (A=[B|C])) :- !. +/* '$do_c_built_in'(X is Y, _, P) :- nonvar(Y), % Don't rewrite variables !, @@ -97,6 +98,7 @@ do_not_compile_expressions :- set_value('$c_arith',[]). '$expand_expr'(F, Q, V), '$do_and'(P, Q, R0), '$do_and'(R0, Comp, R). +*/ '$do_c_built_in'(P, _, P). '$do_c_built_metacall'(G1, Mod, '$execute_wo_mod'(G1,Mod)) :-