FEAT: added support for loading NaN (1.#NaN) and Infinite (1.#INF) values and using them in decimal computations

This feature is optional and can be turned of by using USE_NO_INFINITY compilation define.

Author: Oldes

make/make-settings.r

@@ -12,4 +12,5 @@ Defines: [
 	USE_PNG_CODEC
 	USE_GIF_CODEC
 	USE_JPG_CODEC
+	;USE_NO_INFINITY ;-- use when you don't want to support IEEE infinity
 ]

src/core/f-dtoa.c

@@ -3761,12 +3761,13 @@ dtoa
 #endif
 		{
 		/* Infinity or NaN */
-		*decpt = 9999;
+		*decpt = 1;
 #ifdef IEEE_Arith
 		if (!word1(&u) && !(word0(&u) & 0xfffff))
-			return nrv_alloc("Infinity", rve, 8);
+			return nrv_alloc("1#INF", rve, 5);
 #endif
-		return nrv_alloc("NaN", rve, 3);
+		*sign = 0; //pretend that all NaNs are positive
+		return nrv_alloc("1#NaN", rve, 5);
 		}
 #endif
 #ifdef IBM

src/core/l-scan.c

@@ -957,6 +957,25 @@
 				if (cp[0] == '2' && cp[1] == '#' && cp[2] == '{')
 					{cp++; goto pound;} // very rare
 			}
+
+#ifndef USE_NO_INFINITY
+			if (Skip_To_Char(cp, scan_state->end, 'x')) return TOKEN_PAIR;
+			if (
+				cp[0] == '1' && cp[1] == '.'  && cp[2] == '#'
+				) {
+				if ((  (cp[3] == 'I' || cp[3] == 'i')
+					&& (cp[4] == 'N' || cp[4] == 'n')
+					&& (cp[5] == 'F' || cp[5] == 'f')
+					) || (
+					   (cp[3] == 'N' || cp[3] == 'n')
+					&& (cp[4] == 'a' || cp[4] == 'A')
+					&& (cp[5] == 'N' || cp[5] == 'n')
+				)) {
+					return TOKEN_DECIMAL;
+				}
+			}
+#endif // !USE_NO_INFINITY
+
 			return -TOKEN_INTEGER;
 		}
 		if (HAS_LEX_FLAG(flags, LEX_SPECIAL_COLON)) return TOKEN_TIME;  /* 12:34 */

src/core/l-types.c

@@ -260,6 +260,43 @@ bad_hex:	Trap0(RE_INVALID_CHARS);
 		else cp++;
 	if (*cp == ',' || *cp == '.') cp++;
 	*ep++ = '.';
+
+#ifndef USE_NO_INFINITY
+	if (cp[0] == '#') {
+		if (
+			   (cp[1] == 'I' || cp[1] == 'i')
+			&& (cp[2] == 'N' || cp[2] == 'n')
+			&& (cp[3] == 'F' || cp[3] == 'f')
+		) {
+			cp += 4;
+			if ((REBCNT)(cp - bp) != len) return 0;
+			VAL_SET(value, REB_DECIMAL);
+			VAL_DECIMAL(value) = (bp[0] == '-') ? -INFINITY : INFINITY;
+			return cp;
+		}
+		if (
+			   (cp[1] == 'N' || cp[1] == 'n')
+			&& (cp[2] == 'a' || cp[2] == 'A')
+			&& (cp[3] == 'N' || cp[3] == 'n')
+		) {
+			cp += 4;
+			if ((REBCNT)(cp - bp) != len) return 0;
+			VAL_SET(value, REB_DECIMAL);
+
+			// NOTE: NAN sign may differ!
+			//       VS (17) is producing negative NaN #{FFF8000000000000}, while GCC positive #{7FF8000000000000}!
+			// Is this an issue?
+#if _MSC_VER
+			VAL_DECIMAL(value) = (bp[0] == '-') ? NAN : -NAN;
+#else
+			VAL_DECIMAL(value) = (bp[0] == '-') ? -NAN : NAN;
+#endif
+			return cp;
+		}
+		return 0;
+	}
+#endif // !USE_NO_INFINITY
+
 	while (IS_LEX_NUMBER(*cp) || *cp == '\'')
 		if (*cp != '\'') *ep++ = *cp++, dig=1;
 		else cp++;
@@ -745,13 +782,67 @@ bad_hex:	Trap0(RE_INVALID_CHARS);
 	//ep = Grab_Int(ep, &n);
 	ep = Scan_Dec_Buf(cp, MAX_NUM_LEN, &buf[0]);
 	if (!ep) return 0;
+
+#ifndef USE_NO_INFINITY
+	if (ep[0] == '#') {
+		if (!((buf[0] == '-' && buf[1] == '1' && buf[2] == '.') || (buf[0] == '1' && buf[1] == '.'))) return 0; //don't allow numbers like 20.#INF or -2.#INF
+		if (
+			(ep[1] == 'I' || ep[1] == 'i') &&
+			(ep[2] == 'N' || ep[2] == 'n') &&
+			(ep[3] == 'F' || ep[3] == 'f')
+		) {
+			VAL_PAIR_X(value) = buf[0] == '-' ? -INFINITY : INFINITY;
+			ep += 4;
+		}
+		else if (
+			 (ep[1] == 'N' || ep[1] == 'n')
+		  && (ep[2] == 'a' || ep[2] == 'A')
+		  && (ep[3] == 'N' || ep[3] == 'n')
+		) {
+			ep += 4;
+			VAL_PAIR_X(value) = NAN;
+		}
+		else return 0;
+	} else {
+		VAL_PAIR_X(value) = (float)atof((char*)(&buf[0])); //n;
+	}
+#else
 	VAL_PAIR_X(value) = (float)atof((char*)(&buf[0])); //n;
+#endif // !USE_NO_INFINITY
+	
 	if (*ep != 'x' && *ep != 'X') return 0;
 	ep++;
 
 	xp = Scan_Dec_Buf(ep, MAX_NUM_LEN, &buf[0]);
 	if (!xp) return 0;
+
+#ifndef USE_NO_INFINITY
+	if (xp[0] == '#') {
+		if(!((buf[0]=='-' && buf[1]=='1' && buf[2]=='.') || (buf[0]=='1' && buf[1]=='.'))) return 0; //don't allow numbers like 20.#INF or -2.#INF
+		if (
+			(xp[1] == 'I' || xp[1] == 'i') &&
+			(xp[2] == 'N' || xp[2] == 'n') &&
+			(xp[3] == 'F' || xp[3] == 'f')
+		) {
+			VAL_PAIR_Y(value) = buf[0] == '-' ? -INFINITY : INFINITY;
+			xp += 4;
+		}
+		else if (
+			   (xp[1] == 'N' || xp[1] == 'n')
+			&& (xp[2] == 'a' || xp[2] == 'A')
+			&& (xp[3] == 'N' || xp[3] == 'n')
+		) {
+			xp += 4;
+			VAL_PAIR_Y(value) = NAN;
+		}
+		else return 0;
+	}
+	else {
+		VAL_PAIR_Y(value) = (float)atof((char*)(&buf[0])); //n;
+	}
+#else
 	VAL_PAIR_Y(value) = (float)atof((char*)(&buf[0])); //n;
+#endif // !USE_NO_INFINITY
 
 	if (len > (REBCNT)(xp - cp)) return 0;
 	VAL_SET(value, REB_PAIR);

src/core/t-decimal.c

@@ -95,6 +95,10 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
 	union {REBDEC d; REBI64 i;} ua, ub;
 	REBI64 int_diff;
 
+#ifndef USE_NO_INFINITY
+	if(isnan(a) || isnan(b)) return FALSE;
+#endif // !USE_NO_INFINITY
+
 	ua.d = a;
 	ub.d = b;
 
@@ -287,7 +291,9 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
 
 			case A_DIVIDE:
 			case A_REMAINDER:
+#ifdef USE_NO_INFINITY
 				if (d2 == 0.0) Trap0(RE_ZERO_DIVIDE);
+#endif
 				if (action == A_DIVIDE) d1 /= d2;
 				else d1 = fmod(d1, d2);
 				goto setDec;
@@ -460,7 +466,9 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
 	Trap_Action(VAL_TYPE(val), action);
 
 setDec:
+#ifdef USE_NO_INFINITY
 	if (!FINITE(d1)) Trap0(RE_OVERFLOW);
+#endif
 #ifdef not_required
 	if (type == REB_PERCENT) {
 		// Keep percent in smaller range (not to use e notation).