improve error handling in arithmetic comparison (obs from Jose Santos)

C/cmppreds.c

@@ -524,18 +524,21 @@ flt_cmp(Float dif)
     return -1;
   if (dif > 0.0)
     return 1;
-  return 0;
+  return dif = 0.0;
 }
 
 
 static inline Int
 a_cmp(Term t1, Term t2)
 {
+  ArithError = FALSE;
   if (IsVarTerm(t1)) {
+    ArithError = TRUE;
     Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
     return FALSE;
   }
   if (IsVarTerm(t2)) {
+    ArithError = TRUE;
     Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2");
     return FALSE;
   }
@@ -546,7 +549,9 @@ a_cmp(Term t1, Term t2)
     return int_cmp(IntegerOfTerm(t1)-IntegerOfTerm(t2));
   }
   t1 = Yap_Eval(t1);
-  if (!t1) return FALSE;
+  if (!t1) {
+    return FALSE;
+  }
   if (IsIntegerTerm(t1)) {
     Int i1 = IntegerOfTerm(t1);
     t2 = Yap_Eval(t2);
@@ -556,6 +561,11 @@ a_cmp(Term t1, Term t2)
       return int_cmp(i1-i2);
     } else if (IsFloatTerm(t2)) {
       Float f2 = FloatOfTerm(t2);
+#if HAVE_ISNAN
+      if (isnan(f2)) {
+	ArithError = TRUE;
+      }
+#endif      
       return flt_cmp(i1-f2);
     } else if (IsBigIntTerm(t2)) {
 #ifdef USE_GMP
@@ -567,13 +577,27 @@ a_cmp(Term t1, Term t2)
     }
   } else if (IsFloatTerm(t1)) {
     Float f1 = FloatOfTerm(t1);
+#if HAVE_ISNAN
+    if (isnan(f1)) {
+      ArithError = TRUE;
+    }
+#endif      
     t2 = Yap_Eval(t2);
+#if HAVE_ISNAN
+      if (isnan(f1))
+	return -1;
+#endif      
 
     if (IsIntegerTerm(t2)) {
       Int i2 = IntegerOfTerm(t2);
       return flt_cmp(f1-i2);
     } else if (IsFloatTerm(t2)) {
       Float f2 = FloatOfTerm(t2);
+#if HAVE_ISNAN
+      if (isnan(f2)) {
+	ArithError = TRUE;
+      }
+#endif      
       return flt_cmp(f1-f2);
     } else if (IsBigIntTerm(t2)) {
 #ifdef USE_GMP
@@ -594,6 +618,11 @@ a_cmp(Term t1, Term t2)
 	return int_cmp(mpz_cmp_si(b1,i2));
       } else if (IsFloatTerm(t2)) {
 	Float f2 = FloatOfTerm(t2);
+#if HAVE_ISNAN
+	if (isnan(f2)) {
+	  ArithError = TRUE;
+	}
+#endif      
 	return flt_cmp(mpz_get_d(b1)-f2);
       } else if (IsBigIntTerm(t2)) {
 	MP_INT *b2 = Yap_BigIntOfTerm(t2);
@@ -621,6 +650,8 @@ p_acomp(void)
 static Int 
 a_eq(Term t1, Term t2)
 {				/* A =:= B		 */
+  int out;
+
   if (IsVarTerm(t1)) {
     Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2");
     return(FALSE);
@@ -643,37 +674,43 @@ a_eq(Term t1, Term t2)
       return (FloatOfTerm(t2) == IntegerOfTerm(t1));
     }
   }
-  return (a_cmp(t1,t2) == 0);
+  out = a_cmp(t1,t2);
+  return !ArithError && (out == 0);
 }
 
 static Int 
 a_dif(Term t1, Term t2)
 {
-  return !a_eq(t1,t2);
+  int out = a_cmp(t1,t2);
+  return !ArithError && out != 0;
 }
 
 static Int 
 a_gt(Term t1, Term t2)
 {				/* A > B		 */
-  return a_cmp(t1,t2) > 0;
+  int out = a_cmp(t1,t2);
+  return !ArithError && out > 0;
 }
 
 static Int 
 a_ge(Term t1, Term t2)
 {				/* A >= B		 */
-  return a_cmp(t1,t2) >= 0;
+  int out = a_cmp(t1,t2);
+  return !ArithError && out >= 0;
 }
 
 static Int 
 a_lt(Term t1, Term t2)
 {				/* A < B       */
-  return a_cmp(t1,t2) < 0;
+  int out = a_cmp(t1,t2);
+  return !ArithError && out < 0;
 }
 
 static Int 
 a_le(Term t1, Term t2)
 {				/* A <= B */
-  return a_cmp(t1,t2) <= 0;
+  int out = a_cmp(t1,t2);
+  return !ArithError && out <= 0;
 }
 
 

C/eval.c

@@ -40,6 +40,7 @@ static Term
 Eval(Term t)
 {
   if (IsVarTerm(t)) {
+    ArithError = TRUE;
     return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic");
   } else if (IsAtomTerm(t)) {
     ExpEntry *p;
@@ -156,6 +157,7 @@ Yap_ArithError(yap_error_number type, Term where, char *format,...)
 {
   va_list ap;
 
+  ArithError = TRUE;
   Yap_Error_TYPE = type;
   Yap_Error_Term = where;
   if (!Yap_ErrorMessage)

H/Heap.h

@@ -131,6 +131,7 @@ typedef struct worker_local_struct {
   Int    start_line;
   int    uncaught_throw;
   int    doing_undefp;
+  int    arith_error;
   scratch_block scratchpad;
 #ifdef MULTI_ASSIGNMENT_VARIABLES
   Term   woken_goals;
@@ -695,6 +696,7 @@ extern struct various_codes *Yap_heap_regs;
 #define  ConsultBase              Yap_heap_regs->WL.consultbase
 /* low-water mark for consult  */
 #define  ConsultLow               Yap_heap_regs->WL.consultlow
+#define  ArithError               Yap_heap_regs->WL.arith_error
 #define  LastAssertedPred         Yap_heap_regs->WL.last_asserted_pred
 /* current maximum number of cells in consult stack */
 #define  ConsultCapacity          Yap_heap_regs->WL.consultcapacity