From 9e764c76b406bc5f10527ad08d2d93982c28de64 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Mon, 20 Jul 2009 10:01:05 +0300
Subject: [PATCH] - eqv? and equal? now guarantee #t when given two NaNs
 (unspecified   by R6RS).

---
 scheme/ikarus.predicates.ss | 12 +++++++-----
 scheme/last-revision        |  2 +-
 scheme/makefile.ss          |  1 +
 scheme/tests/numerics.ss    |  6 +++++-
 4 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/scheme/ikarus.predicates.ss b/scheme/ikarus.predicates.ss
index 476b255..6d3c5f9 100644
--- a/scheme/ikarus.predicates.ss
+++ b/scheme/ikarus.predicates.ss
@@ -253,11 +253,13 @@
         [(eq? x y) #t]
         [(flonum? x) 
          (and (flonum? y)
-              (if ($fl= x 0.0)
-                  (and ($fl= y 0.0) 
-                       ($fl= ($fl/ 1.0 x)
-                             ($fl/ 1.0 y)))
-                  (fl=? x y)))]
+              (if ($fl< x y)
+                  #f
+                  (if ($fl> x y)
+                      #f
+                      (if ($fl= x 0.0)
+                          ($fl= ($fl/ 1.0 x) ($fl/ 1.0 y))
+                          #t))))]
         [(bignum? x) (and (bignum? y) (= x y))]
         [(ratnum? x) (and (ratnum? y) (= x y))]
         [(compnum? x)
diff --git a/scheme/last-revision b/scheme/last-revision
index 9b864cc..5bcfdd6 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1826
+1827
diff --git a/scheme/makefile.ss b/scheme/makefile.ss
index 419ed1e..565067d 100755
--- a/scheme/makefile.ss
+++ b/scheme/makefile.ss
@@ -35,6 +35,7 @@
 ((pretty-format 'fix) ((pretty-format 'letrec)))
 (strip-source-info #t)
 
+(current-letrec-pass 'scc)
 (define scheme-library-files
   ;;; Listed in the order in which they're loaded.
   ;;;
diff --git a/scheme/tests/numerics.ss b/scheme/tests/numerics.ss
index f8d5f97..ecdc4a8 100644
--- a/scheme/tests/numerics.ss
+++ b/scheme/tests/numerics.ss
@@ -78,7 +78,11 @@
     (test-eqv 0.0 0.0 #t)
     (test-eqv 0.0 -0.0 #f)
     (test-eqv -0.0 0.0 #f)
-    (test-eqv -0.0 -0.0 #t))
+    (test-eqv -0.0 -0.0 #t)
+    ;;; ikarus extensions, not guaranteed by R6RS
+    (test-eqv +nan.0 +nan.0 #t)
+    (test-eqv (/ +inf.0 +inf.0) (/ -inf.0 +inf.0) #t)
+    (test-eqv +nan.0 (string->number "+nan.0") #t))
 
   (define (test-exact-integer-sqrt)
     (define (f i j inc)