>From 277b36970385aedeb40555d46ef0f5513e7448a7 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 21 Apr 2012 00:13:49 +0200
Subject: [PATCH] Two types.db fixes:

- finite?, exact? and inexact? raise an error on non-numbers.  They are not pure predicates and shouldn't be rewritten to "pure" C functions.
- The "base" (aka "radix") argument for string->number and number->string can only be a fixnum.
---
 tests/library-tests.scm   |   17 +++++++++++++----
 tests/scrutiny-2.expected |   16 ----------------
 types.db                  |   16 ++++++++++------
 3 files changed, 23 insertions(+), 26 deletions(-)

diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 1268bd4..fab5f00 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -2,6 +2,10 @@
 
 (use srfi-1 extras)
 
+(define-syntax assert-fail
+  (syntax-rules ()
+    ((_ exp)
+     (assert (handle-exceptions ex #t exp #f)))))
 
 ;; numbers
 
@@ -20,6 +24,7 @@
 (assert (= 1.0 (round 0.6)))
 (assert (rational? 1))
 (assert (finite? 1))
+(assert-fail (finite? 'foo))
 (assert (rational? 1.0))
 (assert (finite? 1.0))
 (assert (not (rational? +inf.0)))
@@ -40,10 +45,14 @@
 (assert (not (integer? "foo")))
 ; XXX number missing
 
-(define-syntax assert-fail
-  (syntax-rules ()
-    ((_ exp)
-     (assert (handle-exceptions ex #t exp #f)))))
+(assert (exact? 1))
+(assert (not (exact? 1.0)))
+(assert (not (exact? 1.1)))
+(assert-fail (exact? 'foo))
+(assert (not (inexact? 1)))
+(assert (inexact? 1.0))
+(assert (inexact? 1.1))
+(assert-fail (inexact? 'foo))
 
 (assert-fail (/ 1 1 0))
 (assert-fail (/ 1 1 0.0))
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 4bea4df..1985dac 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -60,14 +60,6 @@ Note: at toplevel:
   `float' and will always return false
 
 Note: at toplevel:
-  (scrutiny-tests-2.scm:24) in procedure call to `exact?', the predicate is called with an argument of type
-  `fixnum' and will always return true
-
-Note: at toplevel:
-  (scrutiny-tests-2.scm:24) in procedure call to `exact?', the predicate is called with an argument of type
-  `float' and will always return false
-
-Note: at toplevel:
   (scrutiny-tests-2.scm:25) in procedure call to `flonum?', the predicate is called with an argument of type
   `float' and will always return true
 
@@ -76,14 +68,6 @@ Note: at toplevel:
   `fixnum' and will always return false
 
 Note: at toplevel:
-  (scrutiny-tests-2.scm:26) in procedure call to `inexact?', the predicate is called with an argument of type
-  `float' and will always return true
-
-Note: at toplevel:
-  (scrutiny-tests-2.scm:26) in procedure call to `inexact?', the predicate is called with an argument of type
-  `fixnum' and will always return false
-
-Note: at toplevel:
   (scrutiny-tests-2.scm:27) in procedure call to `number?', the predicate is called with an argument of type
   `fixnum' and will always return true
 
diff --git a/types.db b/types.db
index 7aed56f..61a3dd1 100644
--- a/types.db
+++ b/types.db
@@ -218,10 +218,14 @@
 	  ((fixnum) (let ((#(tmp) #(1))) '#t))
 	  ((float) (##core#inline "C_u_i_fpintegerp" #(1))))
 
-(exact? (#(procedure #:pure #:predicate fixnum) exact? (*) boolean))
 (real? (#(procedure #:pure #:predicate number) real? (*) boolean))
 (complex? (#(procedure #:pure #:predicate number) complex? (*) boolean))
-(inexact? (#(procedure #:pure #:predicate float) inexact? (*) boolean))
+(exact? (#(procedure #:clean #:enforce) exact? (number) boolean)
+        ((fixnum) (let ((#(tmp) #(1))) '#t))
+        ((float) (let ((#(tmp) #(1))) '#f)))
+(inexact? (#(procedure #:clean #:enforce) inexact? (number) boolean)
+          ((fixnum) (let ((#(tmp) #(1))) '#f))
+          ((float) (let ((#(tmp) #(1))) '#t)))
 
 ;;XXX predicate?
 (rational? (#(procedure #:pure) rational? (*) boolean)
@@ -474,10 +478,10 @@
 			       #(2)))
       ((float float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) #(1) #(2))))
 
-(number->string (#(procedure #:clean #:enforce) number->string (number #!optional number) string)
+(number->string (#(procedure #:clean #:enforce) number->string (number #!optional fixnum) string)
 		((fixnum) (##sys#fixnum->string #(1))))
 
-(string->number (#(procedure #:clean #:enforce) string->number (string #!optional number) 
+(string->number (#(procedure #:clean #:enforce) string->number (string #!optional fixnum) 
 		 (or number boolean)))
 
 (char? (#(procedure #:pure #:predicate char) char? (*) boolean))
@@ -802,9 +806,9 @@
 (file-exists? (#(procedure #:clean #:enforce) file-exists? (string) (or boolean string)))
 (directory-exists? (#(procedure #:clean #:enforce) directory-exists? (string) (or boolean string)))
 
-(finite? (#(procedure #:pure) finite? (*) boolean)
+(finite? (#(procedure #:clean #:enforce) finite? (number) boolean)
 	 ((fixnum) (let ((#(tmp) #(1))) '#t))
-	 ((*) (##core#inline "C_i_finitep" #(1))))
+	 (((or float number)) (##core#inline "C_i_finitep" #(1))))
 
 (fixnum-bits fixnum)
 (fixnum-precision fixnum)
-- 
1.7.9.1