suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/ChezScheme/mats/5_3.ms
View File

@ -1724,6 +1724,12 @@
(eqv? (/ 1 -2) -1/2) (eqv? (/ 1 -2) -1/2)
(eqv? (/ 1/2 -2) -1/4) (eqv? (/ 1/2 -2) -1/4)
(eqv? (/ 1 -1/2) -2) (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.0 2) 0.5)
(fl~= (/ 1 2.0) 0.5) (fl~= (/ 1 2.0) 0.5)
(eqv? (/ 0 2.0) 0) (eqv? (/ 0 2.0) 0)

12
racket/src/ChezScheme/s/5_3.ss
View File

@ -86,7 +86,7 @@
(define schoolbook-intquotient (schemeop2 "(cs)ss_trunc")) (define schoolbook-intquotient (schemeop2 "(cs)ss_trunc"))
(define schoolbook-intquotient-remainder (schemeop2 "(cs)ss_trunc_rem")) (define schoolbook-intquotient-remainder (schemeop2 "(cs)ss_trunc_rem"))
(define schoolbook-intremainder (schemeop2 "(cs)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 exgcd (schemeop2 "(cs)gcd"))
(define $flsin (cflop1 "(cs)sin")) (define $flsin (cflop1 "(cs)sin"))
@ -2562,7 +2562,15 @@
[(ratnum?) [(ratnum?)
(type-case x (type-case x
[(fixnum? bignum?) [(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?) [(ratnum?)
(integer/ (* ($ratio-numerator x) ($ratio-denominator y)) (integer/ (* ($ratio-numerator x) ($ratio-denominator y))
(* ($ratio-denominator x) ($ratio-numerator y)))] (* ($ratio-denominator x) ($ratio-numerator y)))]