[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-58-gb9
From: |
Julian Graham |
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-58-gb98d5a5 |
Date: |
Wed, 17 Nov 2010 06:01:03 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b98d5a5a7607b905afa54fd2768210232fa08e16
The branch, master has been updated
via b98d5a5a7607b905afa54fd2768210232fa08e16 (commit)
from eeb48bc27e27976acec41dc0e59e7aaab2b886cd (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit b98d5a5a7607b905afa54fd2768210232fa08e16
Author: Julian Graham <address@hidden>
Date: Wed Nov 17 00:59:45 2010 -0500
Add exports for missing functions from `(rnrs base)'.
* module/rnrs.scm (boolean=?): New export.
Fix typo in export of`integer-valued?'.
* module/rnrs/base.scm: Add exports for `exact' and `inexact'.
(boolean=?, symbol=?, infinite?, finite?, exact-integer-sqrt,
integer-valued?, rational-valued?, real-valued?): New functions.
* test-suite/tests/r6rs-base.test (boolean=?, symbol=?, infinite?,
finite?, exact-integer-sqrt, integer-valued?, rational-valued?,
real-valued?): New test prefixes and tests.
-----------------------------------------------------------------------
Summary of changes:
module/rnrs.scm | 16 ++++++------
module/rnrs/base.scm | 45 ++++++++++++++++++++++++++++++--
test-suite/tests/r6rs-base.test | 54 +++++++++++++++++++++++++++++++++++++++
3 files changed, 104 insertions(+), 11 deletions(-)
diff --git a/module/rnrs.scm b/module/rnrs.scm
index c329aeb..c6f5db1 100644
--- a/module/rnrs.scm
+++ b/module/rnrs.scm
@@ -52,18 +52,18 @@
boolean? symbol? char? vector? null? pair? number? string? procedure?
define define-syntax syntax-rules lambda let let* let-values
- let*-values letrec letrec* begin quote lambda if set! cond case or
and not
- eqv? equal? eq? + - * / max min abs numerator denominator gcd lcm
- floor ceiling truncate round rationalize real-part imag-part
+ let*-values letrec letrec* begin quote lambda if set! cond case or
+ and not eqv? equal? eq? + - * / max min abs numerator denominator gcd
+ lcm floor ceiling truncate round rationalize real-part imag-part
make-rectangular angle div mod div-and-mod div0 mod0 div0-and-mod0
expt exact-integer-sqrt sqrt exp log sin cos tan asin acos atan
make-polar magnitude angle complex? real? rational? integer? exact?
- inexact? real-valued? rational-valued? integer-values? zero?
+ inexact? real-valued? rational-valued? integer-valued? zero?
positive? negative? odd? even? nan? finite? infinite? exact inexact =
- < > <= >= number->string string->number cons car cdr caar cadr cdar
- cddr caaar caadr cadar cdaar caddr cdadr cddar cdddr caaaar caaadr
- caadar cadaar cdaaar cddaar cdadar cdaadr cadadr caaddr caddar cadddr
- cdaddr cddadr cdddar cddddr list? list length append reverse
+ < > <= >= number->string string->number boolean=? cons car cdr caar
+ cadr cdar cddr caaar caadr cadar cdaar caddr cdadr cddar cdddr caaaar
+ caaadr caadar cadaar cdaaar cddaar cdadar cdaadr cadadr caaddr caddar
+ cadddr cdaddr cddadr cdddar cddddr list? list length append reverse
list-tail list-ref map for-each symbol->string string->symbol symbol=?
char->integer integer->char char=? char<? char>? char<=? char>=?
make-string string string-length string-ref string=? string<? string>?
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index 74fce31..6320420 100644
--- a/module/rnrs/base.scm
+++ b/module/rnrs/base.scm
@@ -37,13 +37,15 @@
make-polar magnitude angle
complex? real? rational? integer? exact? inexact? real-valued?
- rational-valued? integer-values? zero? positive? negative? odd? even?
+ rational-valued? integer-valued? zero? positive? negative? odd? even?
nan? finite? infinite?
exact inexact = < > <= >=
number->string string->number
+ boolean=?
+
cons car cdr caar cadr cdar cddr caaar caadr cadar cdaar caddr cdadr
cddar cdddr caaaar caaadr caadar cadaar cdaaar cddaar cdadar cdaadr
cadadr caaddr caddar cadddr cdaddr cddadr cdddar cddddr
@@ -71,8 +73,45 @@
let-syntax letrec-syntax
syntax-rules identifier-syntax)
- (import (rename (guile) (quotient div) (modulo mod))
- (srfi srfi-11))
+ (import (rename (guile)
+ (quotient div)
+ (modulo mod)
+ (exact->inexact inexact)
+ (inexact->exact exact))
+ (srfi srfi-11))
+
+ (define (boolean=? . bools)
+ (define (boolean=?-internal lst last)
+ (or (null? lst)
+ (let ((bool (car lst)))
+ (and (eqv? bool last) (boolean=?-internal (cdr lst) bool)))))
+ (or (null? bools)
+ (let ((bool (car bools)))
+ (and (boolean? bool) (boolean=?-internal (cdr bools) bool)))))
+
+ (define (symbol=? . syms)
+ (define (symbol=?-internal lst last)
+ (or (null? lst)
+ (let ((sym (car lst)))
+ (and (eq? sym last) (symbol=?-internal (cdr lst) sym)))))
+ (or (null? syms)
+ (let ((sym (car syms)))
+ (and (symbol? sym) (symbol=?-internal (cdr syms) sym)))))
+
+ (define (infinite? x) (or (eqv? x +inf.0) (eqv? x -inf.0)))
+ (define (finite? x) (not (infinite? x)))
+
+ (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 integer-valued? integer?)
+ (define rational-valued? rational?)
+ (define real-valued? real?)
(define (vector-for-each proc . vecs)
(apply for-each (cons proc (map vector->list vecs))))
diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test
index 05d5802..a3603a1 100644
--- a/test-suite/tests/r6rs-base.test
+++ b/test-suite/tests/r6rs-base.test
@@ -21,6 +21,60 @@
:use-module ((rnrs base) :version (6))
:use-module (test-suite lib))
+(with-test-prefix "boolean=?"
+ (pass-if "boolean=? null" (boolean=?))
+ (pass-if "boolean=? unary" (boolean=? #f))
+ (pass-if "boolean=? many"
+ (and (boolean=? #t #t #t)
+ (boolean=? #f #f #f)
+ (not (boolean=? #t #f #t))))
+ (pass-if "boolean=? mixed type" (not (boolean=? #t #t 'foo))))
+
+(with-test-prefix "symbol=?"
+ (pass-if "symbol=? null" (symbol=?))
+ (pass-if "symbol=? unary" (symbol=? 'a))
+ (pass-if "symbol=? many"
+ (and (symbol=? 'a 'a 'a)
+ (symbol=? 'foo 'foo 'foo)
+ (not (symbol=? 'a 'foo 'a))))
+ (pass-if "symbol=? mixed type" (not (symbol=? 'a 'a 123))))
+
+(with-test-prefix "infinite?"
+ (pass-if "infinite? true on infinities"
+ (and (infinite? +inf.0) (infinite? -inf.0)))
+ (pass-if "infinite? false on non-infities"
+ (and (not (infinite? 123)) (not (infinite? +nan.0)))))
+
+(with-test-prefix "finite?"
+ (pass-if "finite? false on infinities"
+ (and (not (finite? +inf.0)) (not (finite? -inf.0))))
+ (pass-if "finite? true on non-infinities"
+ (and (finite? 123) (finite? 123.0))))
+
+(with-test-prefix "exact-integer-sqrt"
+ (pass-if "exact-integer-sqrt simple"
+ (let-values (((s e) (exact-integer-sqrt 5)))
+ (and (eqv? s 2) (eqv? e 1)))))
+
+(with-test-prefix "integer-valued?"
+ (pass-if "true on integers"
+ (and (integer-valued? 3) (integer-valued? 3.0) (integer-valued? 3.0+0.0i)))
+ (pass-if "false on rationals" (not (integer-valued? 3.1)))
+ (pass-if "false on reals" (not (integer-valued? +nan.0))))
+
+(with-test-prefix "rational-valued?"
+ (pass-if "true on integers" (rational-valued? 3))
+ (pass-if "true on rationals"
+ (and (rational-valued? 3.1) (rational-valued? 3.1+0.0i)))
+ (pass-if "false on reals"
+ (or (not (rational-valued? +nan.0))
+ (throw 'unresolved))))
+
+(with-test-prefix "real-valued?"
+ (pass-if "true on integers" (real-valued? 3))
+ (pass-if "true on rationals" (real-valued? 3.1))
+ (pass-if "true on reals" (real-valued? +nan.0)))
+
(with-test-prefix "vector-for-each"
(pass-if "vector-for-each simple"
(let ((sum 0))
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-13-58-gb98d5a5,
Julian Graham <=