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

let `min` and `max` preserve exactness

This commit is contained in:
Sunrim KIM (keen) 2014-09-18 23:26:07 +09:00
parent f0ed3b655a
commit 489535e156
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 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)
acc
(loop (cdr args) (min (car args) acc)))))
(if exactp acc (inexact acc))
(loop (cdr args) (min (car args) acc) (and (exact? (car args)) exactp)))))
(define (max . args)
(define (max 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)
acc
(loop (cdr args) (max (car args) acc)))))
(if exactp acc (inexact acc))
(loop (cdr args) (max (car args) acc) (and (exact? (car args)) exactp)))))
(define (floor-quotient i j)
(call-with-values (lambda () (floor/ i j))