Change to simpler Eval mechanism

- avoid duplicate code
- implement different optimised code.

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<<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(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]<<PREG->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]<<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(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) {

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,29 +37,32 @@ 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
+#ifndef NAN
-p_inf(E_ARGS)
+#define NAN      (0.0/0.0)
-{
+#endif
+
+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;
@@ -80,16 +76,9 @@ p_inf(E_ARGS)
 	RFLOAT(INFINITY);
       }
 #endif
-}
+    }
-
+  case op_nan:
-#ifndef NAN
+    {
-#define NAN      (0.0/0.0)
-#endif
-
-
-static E_FUNC
-p_nan(E_ARGS)
-{
 #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
       Yap_Error(TYPE_ERROR_EVALUABLE, TermNil, "evaluating infinity");
       P = (yamop *)FAILCODE;
@@ -103,104 +92,77 @@ p_nan(E_ARGS)
 	RFLOAT(NAN);
       }
 #endif
-}
+    }
-
+  case op_random:
-static E_FUNC
+    {
-p_random(E_ARGS)
-{
       RFLOAT(Yap_random());
-}
+    }
-
+  case op_cputime:
-static E_FUNC
+    {
-p_cputime(E_ARGS)
-{
       RFLOAT((Float)Yap_cputime()/1000.0);
-}
+    }
-
+  case op_heapused:
-static E_FUNC
-p_heapused(E_ARGS)
-{
     RINT(HeapUsed);
-}
+  case op_localsp:
-
-static E_FUNC
-p_localsp(E_ARGS)
-{
 #if SBA
     RINT((Int)ASP);
 #else
     RINT(LCL0 - ASP);
 #endif
-}
+  case op_b:
-
-static E_FUNC
-p_b(E_ARGS)
-{
 #if SBA
     RINT((Int)B);
 #else
     RINT(LCL0 - (CELL *)B);
 #endif
-}
+  case op_env:
-
-static E_FUNC
-p_env(E_ARGS)
-{
 #if SBA
     RINT((Int)YENV);
 #else
     RINT(LCL0 - YENV);
 #endif
-}
+  case op_tr:
-
-static E_FUNC
-p_tr(E_ARGS)
-{
 #if SBA
     RINT(TR);
 #else
     RINT(((CELL *)TR)-LCL0);
 #endif
-}
+  case op_stackfree:
-
+    RINT(Unsigned(ASP) - Unsigned(H));
-static E_FUNC
+  case op_globalsp:
-p_globalsp(E_ARGS)
-{
 #if SBA
     RINT((Int)H);
 #else
     RINT(H - H0);
 #endif
+  }
+  RERROR();
 }
 
-static E_FUNC
+Term Yap_eval_atom(Int f)
-p_stackfree(E_ARGS)
 {
-  RINT(Unsigned(ASP) - Unsigned(H));
+  return eval0(f);
 }
 
-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},
+  {"pi", op_pi},
-  {"e", p_e},
+  {"e", op_e},
-  {"inf", p_inf},
+  {"inf", op_inf},
-  {"nan", p_nan},
+  {"nan", op_nan},
-  {"random", p_random},
+  {"random", op_random},
-  {"cputime", p_cputime},
+  {"cputime", op_cputime},
-  {"heapused", p_heapused},
+  {"heapused", op_heapused},
-  {"local_sp", p_localsp},
+  {"local_sp", op_localsp},
-  {"global_sp", p_globalsp},
+  {"global_sp", op_globalsp},
-  {"$last_choice_pt", p_b},
+  {"$last_choice_pt", op_b},
-  {"$env", p_env},
+  {"$env", op_env},
-  {"$tr", p_tr},
+  {"$tr", op_tr},
-  {"stackfree", p_stackfree},
+  {"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;
 }
 

C/arrays.c

@@ -367,11 +367,9 @@ p_access_array(void)
   Int indx;
 
   if (IsNonVarTerm(ti)) {
-    union arith_ret v;
+    Term nti;
-    if (IsIntTerm(ti))
+    if (IsIntegerTerm(nti=Yap_Eval(ti)))
-      indx = IntOfTerm(ti);
+      indx = IntegerOfTerm(nti);
-    else if (Yap_Eval(ti, &v) == long_int_e)
-      indx = v.Int;
     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;
+    Term nti;
-    if (IsIntTerm(ti))
+    if (IsIntegerTerm(nti=Yap_Eval(ti)))
-      indx = IntOfTerm(ti);
+      indx = IntegerOfTerm(nti);
-    else if (Yap_Eval(ti, &v) == long_int_e)
-      indx =  v.Int;
     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;
+    Term nti;
-    if (IsIntTerm(ti))
+    if (IsVarTerm(ti)) {
-      size = IntOfTerm(ti);
+      Yap_Error(INSTANTIATION_ERROR,ti,"create_array");
-    else if (Yap_Eval(ti, &v) == long_int_e)
+      return (FALSE);
-      size = v.Int;
+    }
+    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))
+  } else {
-    size = IntOfTerm(ti);
+    Term nti;
-  else {
+
-    union arith_ret v;
+    if (IsIntegerTerm(nti=Yap_Eval(ti)))
-    if (Yap_Eval(ti, &v) == long_int_e) {
+      size = IntegerOfTerm(nti);
-      size = v.Int;
-    }
     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))
+  } else {
-    size = IntOfTerm(ti);
+    Term nti;
-  else {
+
-    union arith_ret v;
+    if (IsIntegerTerm(nti=Yap_Eval(ti)))
-    if (Yap_Eval(ti, &v) == long_int_e) {
+      size = IntegerOfTerm(nti);
-      size = v.Int;
-    }
     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))
+  } else {
-    size = IntOfTerm(ti);
+    Term nti;
-  else {
+
-    union arith_ret v;
+    if (IsIntegerTerm(nti=Yap_Eval(ti)))
-    if (Yap_Eval(ti, &v) == long_int_e) {
+      size = IntegerOfTerm(nti);
-      size = v.Int;
-    }
     else {
       Yap_Error(TYPE_ERROR_INTEGER,ti,"create_mmapped_array");
       return (FALSE);
@@ -1583,17 +1575,14 @@ p_assign_static(void)
 
   t2 = Deref(ARG2);
   if (IsNonVarTerm(t2)) {
-    if (IsIntTerm(t2))
+    Term nti;
-      indx = IntOfTerm(t2);
+
+    if (IsIntegerTerm(nti=Yap_Eval(t2)))
+      indx = IntegerOfTerm(nti);
     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);
     }
-    }
   } else {
     Yap_Error(INSTANTIATION_ERROR,t2,"update_array");
     return (FALSE);
@@ -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);
+	if (IsIntegerTerm(nti=Yap_Eval(t3)))
-	else if (Yap_Eval(t3, &v) == long_int_e)
+	  i = IntegerOfTerm(nti);
-	  i = v.Int;
 	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))
+	if (IsIntegerTerm(nti=Yap_Eval(t3)))
-	  i = IntOfTerm(t3);
+	  i = IntegerOfTerm(nti);
-	else if (Yap_Eval(t3, &v) == long_int_e)
-	  i = v.Int;
 	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))
+	if (IsIntegerTerm(nti=Yap_Eval(t3)))
-	  i = IntOfTerm(t3);
+	  i = IntegerOfTerm(nti);
-	else if (Yap_Eval(t3, &v) == long_int_e)
-	  i = v.Int;
 	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))
+	if (IsFloatTerm(nti=Yap_Eval(t3)))
-	  f = FloatOfTerm(t3);
+	  f = FloatOfTerm(nti);
-	else if (Yap_Eval(t3, &v) == double_e)
+	else if (IsIntegerTerm(nti))
-	  f = v.dbl;
+	  f = IntegerOfTerm(nti);
 	else {
 	  WRITE_UNLOCK(ptr->ArRWLock);
 	  Yap_Error(TYPE_ERROR_FLOAT,t3,"assign_static");
@@ -1923,17 +1907,13 @@ p_assign_dynamic(void)
 
   t2 = Deref(ARG2);
   if (IsNonVarTerm(t2)) {
-    if (IsIntTerm(t2))
+    Term nti;
-      indx = IntOfTerm(t2);
+    if (IsIntegerTerm(nti=Yap_Eval(t2))) {
-    else  {
+      indx = IntegerOfTerm(nti);
-      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);
     }
-    }
   } else {
     Yap_Error(INSTANTIATION_ERROR,t2,"update_array");
     return (FALSE);
@@ -2067,17 +2047,13 @@ p_add_to_array_element(void)
 
   t2 = Deref(ARG2);
   if (IsNonVarTerm(t2)) {
-    if (IsIntTerm(t2))
+    Term nti;
-      indx = IntOfTerm(t2);
+    if (IsIntegerTerm(nti=Yap_Eval(t2))) {
-    else  {
+      indx = IntegerOfTerm(nti);
-      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);
     }
-    }
   } else {
     Yap_Error(INSTANTIATION_ERROR,t2,"add_to_array_element");
     return (FALSE);

C/cmppreds.c

@@ -534,14 +534,9 @@ flt_cmp(Float dif)
 }
 
 
-static Int 
+static inline int
-p_acomp(void)
+a_cmp(Term t1, Term t2)
-{				/* $a_compare(?R,+X,+Y) */
+{
-  register blob_type  bt1;
-  Term t1 = Deref(ARG1);
-  Term t2 = Deref(ARG2);
-  union arith_ret v1;
-
   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);
+  t1 = Yap_Eval(t1);
-  switch (bt1) {
+  if (IsIntegerTerm(t1)) {
-  case  long_int_e:
+    t2 = Yap_Eval(t2);
-    {
+    Int i1 = IntegerOfTerm(t1);
-      union arith_ret v2;
-      blob_type bt2 = Yap_Eval(t2, &v2);
 
-      switch (bt2) {
+    if (IsIntegerTerm(t2)) {
-      case  long_int_e:
+      Int i2 = IntegerOfTerm(t2);
-	return(int_cmp(v1.Int-v2.Int));
+      return(int_cmp(i1-i2));
-      case double_e:
+    } else if (IsFloatTerm(t2)) {
-	return(flt_cmp(v1.Int-v2.dbl));
+      Float f2 = FloatOfTerm(2);
+      return(flt_cmp(i1-f2));
+    } else if (IsBigIntTerm(t2)) {
 #ifdef USE_GMP
-      case big_int_e:
+      MP_INT *b2 = Yap_BigIntOfTerm(t2);
-	return(int_cmp(-mpz_cmp_si(v2.big,v1.Int)));
+      return(int_cmp(-mpz_cmp_si(b2,i1)));
 #endif
-      default:
+    } else {
       return(FALSE);
     }
-    }
+  } else if (IsFloatTerm(t1)) {
-  case double_e:
+    t2 = Yap_Eval(t2);
-    {
+    Float f1 = FloatOfTerm(t1);
-      union arith_ret v2;
-      blob_type bt2 = Yap_Eval(t2, &v2);
 
-      switch (bt2) {
+    if (IsIntegerTerm(t2)) {
-      case  long_int_e:
+      Int i2 = IntegerOfTerm(t2);
-	return(flt_cmp(v1.dbl-v2.Int));
+      return(flt_cmp(f1-i2));
-      case double_e:
+    } else if (IsFloatTerm(t2)) {
-	return(flt_cmp(v1.dbl-v2.dbl));
+      Float f2 = FloatOfTerm(2);
+      return(flt_cmp(f1-f2));
+    } else if (IsBigIntTerm(t2)) {
 #ifdef USE_GMP
-      case big_int_e:
+      MP_INT *b2 = Yap_BigIntOfTerm(t2);
-	return(flt_cmp(v1.dbl-mpz_get_d(v2.big)));
+      return(flt_cmp(f1-mpz_get_d(b2)));
 #endif
-      default:
+    } else {
       return(FALSE);
     }
-    }
+  } else if (IsBigIntTerm(t1)) {
 #ifdef USE_GMP
-  case big_int_e:
     {
-      union arith_ret v2;
+    t2 = Yap_Eval(t2);
-      blob_type bt2 = Yap_Eval(t2, &v2);
+    MP_INT *b1 = Yap_BigIntOfTerm(t1);
 
-      switch (bt2) {
+    if (IsIntegerTerm(t2)) {
-      case  long_int_e:
+      Int i2 = IntegerOfTerm(t2);
-	return(int_cmp(mpz_cmp_si(v1.big,v2.Int)));
+      return(int_cmp(mpz_cmp_si(b1,i2)));
-      case double_e:
+    } else if (IsFloatTerm(t2)) {
-	return(flt_cmp(mpz_get_d(v1.big)-v2.dbl));
+      Float f2 = FloatOfTerm(2);
-      case big_int_e:
+      return(flt_cmp(mpz_get_d(b1)-f2));
-	return(int_cmp(mpz_cmp(v1.big,v2.big)));
+    } else if (IsBigIntTerm(t2)) {
-      default:
+      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);
+  t1 = Yap_Eval(t1);
-  switch (bt1) {
+  if (IsIntegerTerm(t1)) {
-  case  long_int_e:
+    t2 = Yap_Eval(t2);
-    {
+    Int i1 = IntegerOfTerm(t1);
-      union arith_ret v2;
-      blob_type bt2 = Yap_Eval(t2, &v2);
 
-      switch (bt2) {
+    if (IsIntegerTerm(t2)) {
-      case  long_int_e:
+      Int i2 = IntegerOfTerm(t2);
-	return(v1.Int == v2.Int);
+      return(i1==i2);
-      case double_e:
+    } else {
-	return(v1.Int == v2.dbl);
+      return FALSE;
-#ifdef USE_GMP
-      case big_int_e:
-	return(-mpz_cmp_si(v2.big,v1.Int) == 0);
-#endif
-      default:
-	return(FALSE);
     }
-    }
+  } else if (IsFloatTerm(t1)) {
-  case double_e:
+    t2 = Yap_Eval(t2);
-    {
+    Float f1 = FloatOfTerm(t1);
-      union arith_ret v2;
-      blob_type bt2 = Yap_Eval(t2, &v2);
 
-      switch (bt2) {
+    if (IsFloatTerm(t2)) {
-      case  long_int_e:
+      Float f2 = FloatOfTerm(2);
-	return(v1.dbl == v2.Int);
+      return(f1 == f2);
-      case double_e:
+    } else {
-	return(v1.dbl == v2.dbl);
+      return FALSE;
-#ifdef USE_GMP
-      case big_int_e:
-	return(v1.dbl == mpz_get_d(v2.big));
-#endif
-      default:
-	return(FALSE);
-      }
     }
+  } else if (IsBigIntTerm(t1)) {
 #ifdef USE_GMP
-  case big_int_e:
     {
-      union arith_ret v2;
+    t2 = Yap_Eval(t2);
-      blob_type bt2 = Yap_Eval(t2, &v2);
+    MP_INT *b1 = Yap_BigIntOfTerm(t1);
 
-      switch (bt2) {
+    if (IsBigIntTerm(t2)) {
-      case  long_int_e:
+      MP_INT *b2 = Yap_BigIntOfTerm(2);
-	return(mpz_cmp_si(v1.big,v2.Int) == 0);
+      return(mpz_cmp(b1,b2) == 0);
-      case double_e:
+    } else {
-	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:
+  } else {
     return(FALSE);
   }
 }
 
 static Int 
 a_dif(Term t1, Term t2)
-{				/* A =\\= B		 */
+{
-  blob_type bt1;
+  return !a_eq(t1,t2);
-  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);
-  }
 }
 
 static Int 
 a_gt(Term t1, Term t2)
 {				/* A > B		 */
-  blob_type bt1;
+  return a_cmp(t1,t2) > 0;
-  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);
-  }
 }
 
 static Int 
 a_ge(Term t1, Term t2)
 {				/* A >= B		 */
-  blob_type bt1;
+  return a_cmp(t1,t2) >= 0;
-  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);
-  }
 }
 
 static Int 
 a_lt(Term t1, Term t2)
 {				/* A < B       */
-  blob_type bt1;
+  return a_cmp(t1,t2) < 0;
-  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);
-  }
 }
 
 static Int 
 a_le(Term t1, Term t2)
 {				/* A <= B */
-  blob_type bt1;
+  return a_cmp(t1,t2) <= 0;
-  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);
-  }
 }
 
 

C/eval.c

@@ -29,65 +29,49 @@ static char     SccsId[] = "%W% %G%";
 
 yap_error_number Yap_matherror = YAP_NO_ERROR;
 
-#define E_FUNC   blob_type
-#define E_ARGS   arith_retptr o
-#define USE_E_ARGS   o
-
-#define TMP_BIG()   ((o)->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)
+Eval(Term t)
 {
-  switch (bt) {
+  if (IsVarTerm(t)) {
-  case long_int_e:
+    Yap_Error(INSTANTIATION_ERROR,TermNil,"in arithmetic");
-    return MkIntegerTerm(res->Int);
+    P = (yamop *)FAILCODE;
-  case double_e:
+    return 0L;;
-    return MkFloatTerm(res->dbl);
+  } else if (IsAtomTerm(t)) {
-#ifdef USE_GMP
+    ExpEntry *p;
-  case big_int_e:
+    Atom name  = AtomOfTerm(t);
-    {
+
-      Term t = Yap_MkBigIntTerm(res->big);
+    if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
-      mpz_clear(res->big);
+      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;
+      return 0L;
+    }
+    return Yap_eval_atom(p->FOfEE);
+  } else if (IsIntTerm(t)) {
     return t;
-    }
+  } else if (IsApplTerm(t)) {
-#endif
-  default:
-    return TermNil;
-  }
-}
-
-static E_FUNC
-Eval(Term t, E_ARGS)
-{
-  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
+      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];
@@ -102,123 +86,32 @@ Eval(Term t, E_ARGS)
 	  P = (yamop *)FAILCODE;
 	  RERROR();
 	}
+	t1 = Eval(ArgOfTerm(1,t));
+	if (t1 == 0L)
+	  return FALSE;
 	if (n == 1)
-	  return(p->FOfEE.unary(ArgOfTerm(1,t), USE_E_ARGS));
+	  return Yap_eval_unary(p->FOfEE, t1);
-	return(p->FOfEE.binary(ArgOfTerm(1,t),ArgOfTerm(2,t), USE_E_ARGS));
+	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));
+    return Eval(HeadOfTerm(t));
-  } 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));
   }
 }
 
-E_FUNC
+Term
-Yap_Eval(Term t, E_ARGS)
+Yap_Eval(Term t)
 {
-  if (IsVarTerm(t)) {
+  return Eval(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);
-    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));
-  }
 }
 
 #ifdef BEAM
@@ -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 = Eval(Deref(ARG2));
-  out = EvalToTerm(bt,&res);
+  if (out == 0L) {
-  if (out == TermNil) {
     Yap_Error(EVALUATION_ERROR_INT_OVERFLOW, ARG2, "is/2");
     return FALSE;
   }

C/gmp_support.c

@@ -22,214 +22,250 @@
 #if USE_GMP
 
 /* add i + j using temporary bigint new */
-MP_INT *
+Term
-Yap_gmp_add_ints(Int i, Int j, MP_INT *new)
+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, -(j+1));
-      mpz_sub_ui(new, new, 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 *
+Term
-Yap_gmp_sub_ints(Int i, Int j, MP_INT *new)
+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, -(j+1));
-      mpz_add_ui(new, new, 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 *
+Term
-Yap_gmp_mul_ints(Int i, Int j, MP_INT *new)
+Yap_gmp_mul_ints(Int i, Int j)
 {
-  mpz_init_set_si(new,i);
+  MP_INT new;
-  mpz_mul_si(new, new, j);
+
-  return new;
+  mpz_init_set_si(&new,i);
+  mpz_mul_si(&new, &new, j);
+  return Yap_MkBigIntTerm(&new);
 }
 
-MP_INT *
+Term 
-Yap_gmp_sll_ints(Int i, Int j, MP_INT *new)
+Yap_gmp_sll_ints(Int i, Int j)
 {
-  mpz_init_set_si(new,i);
+  MP_INT new;
-  mpz_mul_2exp(new, new, j);
+
-  return 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 *
+Term 
-Yap_gmp_add_int_big(Int i, MP_INT *b, MP_INT *new)
+Yap_gmp_add_int_big(Int i, MP_INT *b)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_add(new, new, b);
+
-  return 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 *
+Term 
-Yap_gmp_sub_int_big(Int i, MP_INT *b, MP_INT *new)
+Yap_gmp_sub_int_big(Int i, MP_INT *b)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_sub(new, new, b);
+
-  return 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 *
+Term 
-Yap_gmp_mul_int_big(Int i, MP_INT *b, MP_INT *new)
+Yap_gmp_mul_int_big(Int i, MP_INT *b)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_mul(new, new, b);
+
-  return 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 *
+Term 
-Yap_gmp_sub_big_int(MP_INT *b, Int i, MP_INT *new)
+Yap_gmp_sub_big_int(MP_INT *b, Int i)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_neg(new, new);
+
-  mpz_add(new, new, b);
+  mpz_init_set_si(&new, i);
-  return new;
+  mpz_neg(&new, &new);
+  mpz_add(&new, &new, b);
+  return Yap_MkBigIntTerm(&new);
 }
 
 /* div i / b using temporary bigint new */
-MP_INT *
+Term 
-Yap_gmp_div_big_int(MP_INT *b, Int i, MP_INT *new)
+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_fdiv_q_ui(&new, &new, -i);
-      mpz_neg(new, new);
+      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_tdiv_q_ui(&new, &new, -i);
-      mpz_neg(new, new);
+      mpz_neg(&new, &new);
     }
   }
-  return new;
+  return Yap_MkBigIntTerm(&new);
 }
 
 /* sub i - b using temporary bigint new */
-MP_INT *
+Term 
-Yap_gmp_and_int_big(Int i, MP_INT *b, MP_INT *new)
+Yap_gmp_and_int_big(Int i, MP_INT *b)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_and(new, new, b);
+
-  return 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 *
+Term 
-Yap_gmp_ior_int_big(Int i, MP_INT *b, MP_INT *new)
+Yap_gmp_ior_int_big(Int i, MP_INT *b)
 {
-  mpz_init_set_si(new, i);
+  MP_INT new;
-  mpz_ior(new, new, b);
+
-  return 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 *
+Term 
-Yap_gmp_sll_big_int(MP_INT *b, Int i, MP_INT *new)
+Yap_gmp_sll_big_int(MP_INT *b, Int i)
 {
+  MP_INT new;
+
   if (i > 0) {
-    mpz_init_set(new, b);
+    mpz_init_set(&new, b);
-    mpz_mul_2exp(new, new, i);
+    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 *
+Term 
-Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+Yap_gmp_add_big_big(MP_INT *b1, MP_INT *b2)
 {
-  mpz_init_set(new, b1);
+  MP_INT new;
-  mpz_add(new, new, b2);
+
-  return new;
+  mpz_init_set(&new, b1);
+  mpz_add(&new, &new, b2);
+  return Yap_MkBigIntTerm(&new);
 }
 
-MP_INT *
+Term 
-Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+Yap_gmp_sub_big_big(MP_INT *b1, MP_INT *b2)
 {
-  mpz_init_set(new, b1);
+  MP_INT new;
-  mpz_sub(new, new, b2);
+
-  return new;
+  mpz_init_set(&new, b1);
+  mpz_sub(&new, &new, b2);
+  return Yap_MkBigIntTerm(&new);
 }
 
-MP_INT *
+Term 
-Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+Yap_gmp_mul_big_big(MP_INT *b1, MP_INT *b2)
 {
-  mpz_init_set(new, b1);
+  MP_INT new;
-  mpz_mul(new, new, b2);
+
-  return new;
+  mpz_init_set(&new, b1);
+  mpz_mul(&new, &new, b2);
+  return Yap_MkBigIntTerm(&new);
 }
 
 /* div i / b using temporary bigint new */
-MP_INT *
+Term 
-Yap_gmp_div_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+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 *
+Term 
-Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+Yap_gmp_and_big_big(MP_INT *b1, MP_INT *b2)
 {
-  mpz_init_set(new, b1);
+  MP_INT new;
-  mpz_and(new, new, b2);
+
-  return new;
+  mpz_init_set(&new, b1);
+  mpz_and(&new, &new, b2);
+  return Yap_MkBigIntTerm(&new);
 }
 
-MP_INT *
+Term 
-Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2, MP_INT *new)
+Yap_gmp_ior_big_big(MP_INT *b1, MP_INT *b2)
 {
-  mpz_init_set(new, b1);
+  MP_INT new;
-  mpz_ior(new, new, b2);
+
-  return new;
+  mpz_init_set(&new, b1);
+  mpz_ior(&new, &new, b2);
+  return Yap_MkBigIntTerm(&new);
 }
 
 Float

C/mavar.c

@@ -49,9 +49,9 @@ p_setarg(void)
     if (IsIntTerm(ti))
       i = IntOfTerm(ti);
     else {
-      union arith_ret v;
+      Term te = Yap_Eval(ti);
-      if (Yap_Eval(ti, &v) == long_int_e) {
+      if (IsIntegerTerm(te)) {
-	i = v.Int;
+	i = IntegerOfTerm(te);
       } else {
 	Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
 	return FALSE;

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) {
+    if (IsIntegerTerm(te)) {
-	newFl = v.Int;
+      newFl = IntegerOfTerm(te);
     } else {
       UNLOCK(pe->PELock);
       Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");

H/Yatom.h

@@ -499,12 +499,7 @@ typedef struct
   BITS16 ENoOfEE;
   BITS16 FlagsOfEE;
   /* operations that implement the expression */
-  union
+  int FOfEE;
-  {
-    blob_type (*constant) (eval_ret);
-    blob_type (*unary) (Term, eval_ret);
-    blob_type (*binary) (Term, Term, eval_ret);
-  } FOfEE;
 } ExpEntry;
 #if USE_OFFSETS_IN_PROPS
 

H/eval.h

@@ -39,23 +39,83 @@
 #define Int_MIN  (-Int_MAX-(CELL)1)
 #endif
 
-typedef union arith_ret {
+typedef enum {
-  Int Int;
+  op_pi,
-  Float dbl;
+  op_e,
-#ifdef USE_GMP
+  op_inf,
-  mpz_t big;
+  op_nan,
-#endif
+  op_random,
-} *arith_retptr;
+  op_cputime,
+  op_heapused,
+  op_localsp,
+  op_globalsp,
+  op_b,
+  op_env,
+  op_tr,
+  op_stackfree
+} arith0_op;
 
-/*
+typedef enum {
-#define RINT(v)     return(MkIntegerTerm(v))
+  op_uplus,
-#define RFLOAT(v)   return(MkFloatTerm(v))
+  op_uminus,
-#define RBIG(v)     return(Yap_MkBigIntTerm(v))
+  op_unot,
-#define RBIG_FL(v)  return(Yap_MkBigIntTerm((MP_INT *)(Int)v))
+  op_exp,
-#define RERROR()    return(MkIntTerm(0))
+  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 *));
+Term  STD_PROTO(Yap_gmp_add_ints,(Int, Int));
-MP_INT *STD_PROTO(Yap_gmp_sub_ints,(Int, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sub_ints,(Int, Int));
-MP_INT *STD_PROTO(Yap_gmp_mul_ints,(Int, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_mul_ints,(Int, Int));
-MP_INT *STD_PROTO(Yap_gmp_sll_ints,(Int, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sll_ints,(Int, Int));
-MP_INT *STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_add_int_big,(Int, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sub_int_big,(Int, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sub_big_int,(MP_INT *, Int));
-MP_INT *STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_mul_int_big,(Int, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_div_big_int,(MP_INT *, Int));
-MP_INT *STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_and_int_big,(Int, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_ior_int_big,(Int, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sll_big_int,(MP_INT *, Int));
-MP_INT *STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_add_big_big,(MP_INT *, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_sub_big_big,(MP_INT *, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_mul_big_big,(MP_INT *, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_div_big_big,(MP_INT *, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_and_big_big,(MP_INT *, MP_INT *));
-MP_INT *STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *, MP_INT *));
+Term  STD_PROTO(Yap_gmp_ior_big_big,(MP_INT *, MP_INT *));
 
 
 

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)) :-