From 84e37896d99dacca308aeb463edec6fdcc70249e Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 2 May 2018 23:15:02 -0700
Subject: [PATCH] Add support for parsing nan.0, +inf.0, and -inf.0.

Not sure if nan.0 is meaningful, but it shouldn't do any harm.
---
 src/compiler/fgopt/folcon.scm | 14 +++++++-------
 src/runtime/numpar.scm        | 10 +++++++---
 src/runtime/parser.scm        |  4 +++-
 src/sf/object.scm             |  4 ++--
 tests/runtime/test-arith.scm  | 36 +++++++++++++++++------------------
 5 files changed, 37 insertions(+), 31 deletions(-)

diff --git a/src/compiler/fgopt/folcon.scm b/src/compiler/fgopt/folcon.scm
index 86cca53b0..aa367db5f 100644
--- a/src/compiler/fgopt/folcon.scm
+++ b/src/compiler/fgopt/folcon.scm
@@ -181,13 +181,13 @@ USA.
 			    (apply op operands))))))
 		  (and (not (condition? value))
 		       (let ((constant (make-constant value)))
-		  (combination/constant! combination constant)
-		  (for-each (lambda (value)
-			      (if (uni-continuation? value)
-				  (maybe-fold-lvalue!
-				   (uni-continuation/parameter value)
-				   constant)))
-			    (rvalue-values continuation))
+			 (combination/constant! combination constant)
+			 (for-each (lambda (value)
+				     (if (uni-continuation? value)
+					 (maybe-fold-lvalue!
+					  (uni-continuation/parameter value)
+					  constant)))
+				   (rvalue-values continuation))
 			 true))))))))
 
 (define (maybe-fold-lvalue! lvalue constant)
diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm
index 34fab3e20..dae16cc85 100644
--- a/src/runtime/numpar.scm
+++ b/src/runtime/numpar.scm
@@ -34,9 +34,13 @@ USA.
 	 (end (fix:end-index end (string-length string) caller))
 	 (start (fix:start-index start end caller))
 	 (z
-	  (parse-number string start end
-			(if (default-object? radix) #f radix)
-			caller)))
+	  (cond ((string=? string "nan.0") (flo:nan.0))
+		((string=? string "+inf.0") (flo:+inf.0))
+		((string=? string "-inf.0") (flo:-inf.0))
+		(else
+		 (parse-number string start end
+			       (if (default-object? radix) #f radix)
+			       caller)))))
     (if (and (not z) (if (default-object? error?) #f error?))
 	(error:bad-range-argument string caller))
     z))
diff --git a/src/runtime/parser.scm b/src/runtime/parser.scm
index 8b4963ce1..f27ad2003 100644
--- a/src/runtime/parser.scm
+++ b/src/runtime/parser.scm
@@ -433,7 +433,9 @@ USA.
   ctx
   (let ((string (parse-atom db (list char))))
     (or (maybe-keyword db string)
-	(make-symbol db string))))
+	(if (string=? string "nan.0")
+	    (flo:nan.0)
+	    (make-symbol db string)))))
 
 (define (maybe-keyword db string)
   (cond ((and (eq? 'suffix (db-keyword-style db))
diff --git a/src/sf/object.scm b/src/sf/object.scm
index 0924a6123..ef6129bfc 100644
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -448,8 +448,8 @@ USA.
           ;; Check that the arguments are constant.
        (every constant? operands)
        (not (condition?
-       (let ((operator (constant/value operator))
-	     (operands (map constant/value operands)))
+	     (let ((operator (constant/value operator))
+		   (operands (map constant/value operands)))
 	       (ignore-errors
 		(lambda ()
 		  (apply operator operands))))))))
diff --git a/tests/runtime/test-arith.scm b/tests/runtime/test-arith.scm
index 7652187b8..c80e08044 100644
--- a/tests/runtime/test-arith.scm
+++ b/tests/runtime/test-arith.scm
@@ -61,44 +61,44 @@ USA.
 
 (define-enumerated^2-test* 'ORDER-WITH-INFINITIES
   (vector (flo:-inf.0) -2. -1 -0.5 0 +0.5 +1 +2. (flo:+inf.0))
-	(lambda (i vi j vj)
-	  (if (< i j)
-	      (assert-true (< vi vj))
-	      (assert-false (< vi vj)))))
+  (lambda (i vi j vj)
+    (if (< i j)
+	(assert-true (< vi vj))
+	(assert-false (< vi vj)))))
 
 (let ((elements (vector (flo:-inf.0) -2. -1 -0. 0 +0. +1 +2. (flo:+inf.0))))
-	(define-enumerated-test '!NAN<X elements
+  (define-enumerated-test '!NAN<X elements
     (lambda (v) (assert-false (< (flo:nan.0) v))))
-	(define-enumerated-test '!X<NAN elements
+  (define-enumerated-test '!X<NAN elements
     (lambda (v) (assert-false (< v (flo:nan.0))))))
 (let ((elements (vector -2. -1 -0. 0 +0. +1 +2.)))
 
-	(define-enumerated-test 'MIN-INF-/X elements
+  (define-enumerated-test 'MIN-INF-/X elements
     (lambda (v) (assert-= (min (flo:-inf.0) v) (flo:-inf.0))))
-	(define-enumerated-test 'MIN-INF+/X elements
+  (define-enumerated-test 'MIN-INF+/X elements
     (lambda (v) (assert-= (min (flo:+inf.0) v) v)))
-	(define-enumerated-test 'MIN-X/INF- elements
+  (define-enumerated-test 'MIN-X/INF- elements
     (lambda (v) (assert-= (min v (flo:-inf.0)) (flo:-inf.0))))
-	(define-enumerated-test 'MIN-X/INF+ elements
+  (define-enumerated-test 'MIN-X/INF+ elements
     (lambda (v) (assert-= (min v (flo:+inf.0)) v)))
 
-	(define-enumerated-test 'MAX-INF-/X elements
+  (define-enumerated-test 'MAX-INF-/X elements
     (lambda (v) (assert-= (max (flo:-inf.0) v) v)))
-	(define-enumerated-test 'MAX-INF+/X elements
+  (define-enumerated-test 'MAX-INF+/X elements
     (lambda (v) (assert-= (max (flo:+inf.0) v) (flo:+inf.0))))
-	(define-enumerated-test 'MAX-X/INF- elements
+  (define-enumerated-test 'MAX-X/INF- elements
     (lambda (v) (assert-= (max v (flo:-inf.0)) v)))
-	(define-enumerated-test 'MAX-X/INF+ elements
+  (define-enumerated-test 'MAX-X/INF+ elements
     (lambda (v) (assert-= (max v (flo:+inf.0)) (flo:+inf.0)))))
 
 (let ((elements (vector (flo:-inf.0) -2. -1 -0. 0 +0. +1 +2. (flo:+inf.0))))
-	(define-enumerated-test 'MIN-NAN/X elements
+  (define-enumerated-test 'MIN-NAN/X elements
     (lambda (v) (assert-= (min (flo:nan.0) v) v)))
-	(define-enumerated-test 'MIN-X/NAN elements
+  (define-enumerated-test 'MIN-X/NAN elements
     (lambda (v) (assert-= (min v (flo:nan.0)) v)))
-	(define-enumerated-test 'MAX-NAN/X elements
+  (define-enumerated-test 'MAX-NAN/X elements
     (lambda (v) (assert-= (max (flo:nan.0) v) v)))
-	(define-enumerated-test 'MAX-X/NAN elements
+  (define-enumerated-test 'MAX-X/NAN elements
     (lambda (v) (assert-= (max v (flo:nan.0)) v))))
 
 (define-enumerated-test 'NAN*X
-- 
2.25.1