mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Implement R6RS real-valued?', rational-valued?', `integer-valued?'

Browse source 
* module/rnrs/base.scm (real-valued?, rational-valued?,
  integer-valued?): Implement in compliance with R6RS.

* test-suite/tests/r6rs-base.test: Add test cases for
  `real-valued?', `rational-valued?', and `integer-valued?'.

* NEWS: Add NEWS entries.
This commit is contained in:
Mark H Weaver 2011-01-28 23:42:01 -05:00 • committed by Andy Wingo
parent c960e55600
commit 8f2339c436
3 changed files with 102 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

4
NEWS
View file

@ -76,6 +76,10 @@ by scheme, despite their name).
throws exceptions for non-numbers. (Note that NaNs _are_ considered
numbers by scheme, despite their name).
**** `real-valued?', `rational-valued?' and `integer-valued?' changes
These predicates are now implemented in accordance with R6RS.
** New reader option: `hungry-eol-escapes'
Guile's string syntax is more compatible with R6RS when the

17
module/rnrs/base.scm
View file

@ -102,14 +102,17 @@
(define (exact-integer-sqrt x)
(let* ((s (exact (floor (sqrt x)))) (e (- x (* s s)))) (values s e)))
;; These definitions should be revisited, since the behavior of Guile's
;; implementations of `integer?', `rational?', and `real?' (exported from this
;; library) is not entirely consistent with R6RS's requirements for those
;; functions.
(define (real-valued? x)
(and (complex? x)
(zero? (imag-part x))))
(define integer-valued? integer?)
(define rational-valued? rational?)
(define real-valued? real?)
(define (rational-valued? x)
(and (real-valued? x)
(rational? (real-part x))))
(define (integer-valued? x)
(and (rational-valued? x)
(= x (floor (real-part x)))))
(define (vector-for-each proc . vecs)
(apply for-each (cons proc (map vector->list vecs))))

89
test-suite/tests/r6rs-base.test
View file

@ -1,6 +1,6 @@
;;; r6rs-base.test --- Test suite for R6RS (rnrs base)
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@ -85,3 +85,90 @@
(pass-if "vector-map simple"
(equal? '#(3 2 1) (vector-map (lambda (x) (- 4 x)) '#(1 2 3)))))
(with-test-prefix "real-valued?"
(pass-if (real-valued? +nan.0))
(pass-if (real-valued? +nan.0+0i))
(pass-if (real-valued? +nan.0+0.0i))
(pass-if (real-valued? +inf.0))
(pass-if (real-valued? -inf.0))
(pass-if (real-valued? +inf.0+0.0i))
(pass-if (real-valued? -inf.0-0.0i))
(pass-if (real-valued? 3))
(pass-if (real-valued? -2.5))
(pass-if (real-valued? -2.5+0i))
(pass-if (real-valued? -2.5+0.0i))
(pass-if (real-valued? -2.5-0i))
(pass-if (real-valued? #e1e10))
(pass-if (real-valued? 1e200))
(pass-if (real-valued? 1e200+0.0i))
(pass-if (real-valued? 6/10))
(pass-if (real-valued? 6/10+0.0i))
(pass-if (real-valued? 6/10+0i))
(pass-if (real-valued? 6/3))
(pass-if (not (real-valued? 3+i)))
(pass-if (not (real-valued? -2.5+0.01i)))
(pass-if (not (real-valued? +nan.0+0.01i)))
(pass-if (not (real-valued? +nan.0+nan.0i)))
(pass-if (not (real-valued? +inf.0-0.01i)))
(pass-if (not (real-valued? +0.01i)))
(pass-if (not (real-valued? -inf.0i))))
(with-test-prefix "rational-valued?"
(pass-if (not (rational-valued? +nan.0)))
(pass-if (not (rational-valued? +nan.0+0i)))
(pass-if (not (rational-valued? +nan.0+0.0i)))
(pass-if (not (rational-valued? +inf.0)))
(pass-if (not (rational-valued? -inf.0)))
(pass-if (not (rational-valued? +inf.0+0.0i)))
(pass-if (not (rational-valued? -inf.0-0.0i)))
(pass-if (rational-valued? 3))
(pass-if (rational-valued? -2.5))
(pass-if (rational-valued? -2.5+0i))
(pass-if (rational-valued? -2.5+0.0i))
(pass-if (rational-valued? -2.5-0i))
(pass-if (rational-valued? #e1e10))
(pass-if (rational-valued? 1e200))
(pass-if (rational-valued? 1e200+0.0i))
(pass-if (rational-valued? 6/10))
(pass-if (rational-valued? 6/10+0.0i))
(pass-if (rational-valued? 6/10+0i))
(pass-if (rational-valued? 6/3))
(pass-if (not (rational-valued? 3+i)))
(pass-if (not (rational-valued? -2.5+0.01i)))
(pass-if (not (rational-valued? +nan.0+0.01i)))
(pass-if (not (rational-valued? +nan.0+nan.0i)))
(pass-if (not (rational-valued? +inf.0-0.01i)))
(pass-if (not (rational-valued? +0.01i)))
(pass-if (not (rational-valued? -inf.0i))))
(with-test-prefix "integer-valued?"
(pass-if (not (integer-valued? +nan.0)))
(pass-if (not (integer-valued? +nan.0+0i)))
(pass-if (not (integer-valued? +nan.0+0.0i)))
(pass-if (not (integer-valued? +inf.0)))
(pass-if (not (integer-valued? -inf.0)))
(pass-if (not (integer-valued? +inf.0+0.0i)))
(pass-if (not (integer-valued? -inf.0-0.0i)))
(pass-if (integer-valued? 3))
(pass-if (integer-valued? 3.0))
(pass-if (integer-valued? 3+0i))
(pass-if (integer-valued? 3+0.0i))
(pass-if (integer-valued? 8/4))
(pass-if (integer-valued? #e1e10))
(pass-if (integer-valued? 1e200))
(pass-if (integer-valued? 1e200+0.0i))
(pass-if (not (integer-valued? -2.5)))
(pass-if (not (integer-valued? -2.5+0i)))
(pass-if (not (integer-valued? -2.5+0.0i)))
(pass-if (not (integer-valued? -2.5-0i)))
(pass-if (not (integer-valued? 6/10)))
(pass-if (not (integer-valued? 6/10+0.0i)))
(pass-if (not (integer-valued? 6/10+0i)))
(pass-if (not (integer-valued? 3+i)))
(pass-if (not (integer-valued? -2.5+0.01i)))
(pass-if (not (integer-valued? +nan.0+0.01i)))
(pass-if (not (integer-valued? +nan.0+nan.0i)))
(pass-if (not (integer-valued? +inf.0-0.01i)))
(pass-if (not (integer-valued? +0.01i)))
(pass-if (not (integer-valued? -inf.0i))))