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.

diff --git a/src/compiler/fgopt/folcon.scm b/src/compiler/fgopt/folcon.scm
index 86cca53b023cde6e9e101191161e7902740c6503..aa367db5fdd7d4b54397b0f5afe9203557d4e0b6 100644 (file)
--- 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))))))))
 \f
 (define (maybe-fold-lvalue! lvalue constant)

diff --git a/src/runtime/numpar.scm b/src/runtime/numpar.scm
index 34fab3e207232b0a9c8360c0218ee198352cdfc0..dae16cc85d08a47765b04bbd430d50851116431f 100644 (file)
--- 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 8b4963ce1c8230f5dc395acd96f49f170480080b..f27ad2003c2dc14d796ca4e329011e3a80bec1d6 100644 (file)
--- 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 0924a612373327b7e347fc3c038e81ba1ca2071c..ef6129bfc29afbbeaf0637c42ab128edf344baa8 100644 (file)
--- 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 7652187b88f4e64b52c1b44125fa0e458412e9a1..c80e08044472e43da417db6d8f747d47e74b9cbb 100644 (file)
--- 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