conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge pull request #216 from KeenS/min-max-exactness 

let `min` and `max` preserve exactness
This commit is contained in:
Yuichi Nishiwaki 2014-09-18 23:56:09 +09:00
parent f0ed3b655a 489535e156
commit abc86efc55
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
piclib/scheme/base.scm
View File

@ -201,18 +201,18 @@
(define (min . args) (define (min . args)
(define (min a b) (define (min a b)
(if (< a b) a b)) (if (< a b) a b))
(let loop ((args args) (acc +inf.0)) (let loop ((args args) (acc +inf.0) (exactp #t))
(if (null? args) (if (null? args)
acc (if exactp acc (inexact acc))
(loop (cdr args) (min (car args) acc))))) (loop (cdr args) (min (car args) acc) (and (exact? (car args)) exactp)))))
(define (max . args) (define (max . args)
(define (max a b) (define (max a b)
(if (> a b) a b)) (if (> a b) a b))
(let loop ((args args) (acc -inf.0)) (let loop ((args args) (acc -inf.0) (exactp #t))
(if (null? args) (if (null? args)
acc (if exactp acc (inexact acc))
(loop (cdr args) (max (car args) acc))))) (loop (cdr args) (max (car args) acc) (and (exact? (car args)) exactp)))))
(define (floor-quotient i j) (define (floor-quotient i j)
(call-with-values (lambda () (floor/ i j)) (call-with-values (lambda () (floor/ i j))