Chez Scheme: special case for / on 1 or -1 and an exact rational

Related to #3816, but Sam already has better changes on the way.
This commit is contained in:
Matthew Flatt 2021-05-06 08:08:38 -06:00
parent 1ad3b05213
commit e368f9e22b
2 changed files with 16 additions and 2 deletions

View File

@ -1724,6 +1724,12 @@
(eqv? (/ 1 -2) -1/2)
(eqv? (/ 1/2 -2) -1/4)
(eqv? (/ 1 -1/2) -2)
(eqv? (/ 1 -1/2) -2)
(eqv? (/ -1 -1/2) 2)
(eqv? (/ 1 3/2) 2/3)
(eqv? (/ -1 3/2) -2/3)
(eqv? (/ 1 -3/2) -2/3)
(eqv? (/ -1 -3/2) 2/3)
(fl~= (/ 1.0 2) 0.5)
(fl~= (/ 1 2.0) 0.5)
(eqv? (/ 0 2.0) 0)

View File

@ -86,7 +86,7 @@
(define schoolbook-intquotient (schemeop2 "(cs)ss_trunc"))
(define schoolbook-intquotient-remainder (schemeop2 "(cs)ss_trunc_rem"))
(define schoolbook-intremainder (schemeop2 "(cs)rem"))
(define make-ratnum (schemeop2 "(cs)s_rational"))
(define make-ratnum (schemeop2 "(cs)s_rational")) ; does not normalize, except detecting 1 as demoninator
(define exgcd (schemeop2 "(cs)gcd"))
(define $flsin (cflop1 "(cs)sin"))
@ -2562,7 +2562,15 @@
[(ratnum?)
(type-case x
[(fixnum? bignum?)
(integer/ (* x ($ratio-denominator y)) ($ratio-numerator y))]
(cond
[(eq? x 1) (if (negative? ($ratio-numerator y))
(make-ratnum ($negate who ($ratio-denominator y)) ($negate who ($ratio-numerator y)))
(make-ratnum ($ratio-denominator y) ($ratio-numerator y)))]
[(eq? x -1) (if (negative? ($ratio-numerator y))
(make-ratnum ($ratio-denominator y) ($negate who ($ratio-numerator y)))
(make-ratnum ($negate who ($ratio-denominator y)) ($ratio-numerator y)))]
[else
(integer/ (* x ($ratio-denominator y)) ($ratio-numerator y))])]
[(ratnum?)
(integer/ (* ($ratio-numerator x) ($ratio-denominator y))
(* ($ratio-denominator x) ($ratio-numerator y)))]