[CM] floor, ceiling, truncate, round, lcm do not conform to R7RS in S7 Scheme

[Da Shen]

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)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://cm-mail.stanford.edu/pipermail/cmdist/attachments/20241125/c09ec2f4/attachment.html>