Hi,
I've found a few numbers-related problems in the types database.
The finite?, exact? and inexact? procedures were marked as being pure
predicates accepting any type of input. They were also rewritten to C
functions that always return a boolean value, but all three raise a
type error in the interpreter when called with non-number values.
Of course, that results in an annoying inconsistency between compiled
code and interpreted code (where the latter gives an error while the
former does not).
The patch adds a few more tests (and moves the assert-fail definition
to the top so that they can be added at the most logical place)
Unfortunately, this gets rid of the warning messages when you pass
a number that's already known to be exact or inexact to exact?/inexact?,
but I think that's not too big a loss.
Some notes/questions:
- Maybe the C functions C_inexactp and such should be the ones that raise
the exception, rather than the Scheme code? I don't know where else
they are used or what's most consistent/clean.
- The rewrites in c-platform.scm seem kind of redundant with the rewrites
done by the scrutinizer and possibly wrong for these cases too, so
another potential hiding place for many bugs.
Now that we have the scrutinizer I think they can probably be removed
altogether without loss of performance in compiled code. This should
also result in faster compilation times since the rewriting code seems
rather complicated too (and it's hard to understand, so getting rid of
it is probably a good idea maintenance-wise too).
I'm just not sure whether all functionality is truly duplicated in
types.db. Of course if we remove it, this should wait until after
4.8.0 is released.
- I noticed that with -O4, the following code passes cleanly:
(define-syntax assert-fail
(syntax-rules ()
((_ exp) (assert (handle-exceptions ex #t exp #f)))))
(assert (exact? 1))
(assert (not (exact? 1)))
(assert-fail (exact? 1))
Could someone explain how this is possible? -debug o didn't
really help, nor did ripping the rewrites from c-platform.scm
Cheers,
Peter
--
http://sjamaan.ath.cx
--
"The process of preparing programs for a digital computer
is especially attractive, not only because it can be economically
and scientifically rewarding, but also because it can be an aesthetic
experience much like composing poetry or music."
-- Donald Knuth
>From 277b36970385aedeb40555d46ef0f5513e7448a7 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter....@xs4all.nl>
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
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
