As described in Page 37 of R7RS: (floor 3.5) => 3.5 But in S7 Scheme: (floor 3.5) => 3 Tested on Debian 12, the floor routine in GNU Guile 3.0.8 conforms to R7RS. The following code snippets (Re-define and unit tests) are used to make them conform to R7RS in Goldfish Scheme: (define s7-floor floor) (define (floor x) (if (inexact? x) (inexact (s7-floor x)) (s7-floor x))) (define s7-ceiling ceiling) (define (ceiling x) (if (inexact? x) (inexact (s7-ceiling x)) (s7-ceiling x))) (define s7-truncate truncate) (define (truncate x) (if (inexact? x) (inexact (s7-truncate x)) (s7-truncate x))) (define s7-round round) (define (round x) (if (inexact? x) (inexact (s7-round x)) (s7-round x))) (define (floor-quotient x y) (floor (/ x y))) (define s7-lcm lcm) (define (lcm2 x y) (cond ((and (inexact? x) (exact? y)) (inexact (s7-lcm (exact x) y))) ((and (exact? x) (inexact? y)) (inexact (s7-lcm x (exact y)))) ((and (inexact? x) (inexact? y)) (inexact (s7-lcm (exact x) (exact y)))) (else (s7-lcm x y)))) (define (lcm . args) (cond ((null? args) 1) ((null? (cdr args)) (car args)) ((null? (cddr args)) (lcm2 (car args) (cadr args))) (else (apply lcm (cons (lcm (car args) (cadr args)) (cddr args)))))) Unit tests: (check (floor 1.1) => 1.0) (check (floor 1) => 1) (check (floor 1/2) => 0) (check (floor 0) => 0) (check (floor -1) => -1) (check (floor -1.2) => -2.0) (check (s7-floor 1.1) => 1) (check (s7-floor -1.2) => -2) (check (ceiling 1.1) => 2.0) (check (ceiling 1) => 1) (check (ceiling 1/2) => 1) (check (ceiling 0) => 0) (check (ceiling -1) => -1) (check (ceiling -1.2) => -1.0) (check (s7-ceiling 1.1) => 2) (check (s7-ceiling -1.2) => -1) (check (truncate 1.1) => 1.0) (check (truncate 1) => 1) (check (truncate 1/2) => 0) (check (truncate 0) => 0) (check (truncate -1) => -1) (check (truncate -1.2) => -1.0) (check (s7-truncate 1.1) => 1) (check (s7-truncate -1.2) => -1) (check (round 1.1) => 1.0) (check (round 1.5) => 2.0) (check (round 1) => 1) (check (round 1/2) => 0) (check (round 0) => 0) (check (round -1) => -1) (check (round -1.2) => -1.0) (check (round -1.5) => -2.0)
_______________________________________________ Cmdist mailing list [email protected] https://cm-mail.stanford.edu/mailman/listinfo/cmdist
