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

cs: fix ->fl and fl->exact-integer to match intended constraints

Browse Source 
Fix `->fl` to work only on exact integers, and fix `fl->exact-integer`
to work only on integer flonums.
This commit is contained in:
Matthew Flatt 2021-05-06 07:14:52 -06:00
parent 180983fb4b
commit 1ad3b05213
2 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/racket-test-core/tests/racket/flonum.rktl
View File

@ -47,6 +47,18 @@
(test #t same-results (list-ref line 0) (list-ref line 1) (list i k j))
(test #t same-results (list-ref line 0) (list-ref line 1) (cons i more-flonums))))))
(test 3.0 ->fl 3)
(test (exact->inexact (expt 2 100)) ->fl (expt 2 100))
(err/rt-test (->fl 3.0))
(err/rt-test (->fl 1/3))
(test 3 fl->exact-integer 3.0)
(test (inexact->exact 1e100) fl->exact-integer 1e100)
(err/rt-test (fl->exact-integer 3.1))
(err/rt-test (fl->exact-integer 3))
(err/rt-test (fl->exact-integer 1/3))
(err/rt-test (fl->exact-integer 1.0+2.0i))
(err/rt-test (flvector-ref (flvector 4.0 5.0 6.0) 4) exn:fail:contract? #rx"[[]0, 2[]]")
(err/rt-test (flvector-set! (flvector 4.0 5.0 6.0) 4 0.0) exn:fail:contract? #rx"[[]0, 2[]]")

10
racket/src/cs/rumble/number.ss
View File

@ -114,10 +114,14 @@
(define (fxlshift/wraparound x y) (#2%fxsll/wraparound x y))
(define (fl->fx x) (#2%flonum->fixnum x))
(define (->fl x) (#2%real->flonum x))
(define/who (->fl x)
(cond
[(fixnum? x) (fixnum->flonum x)]
[(bignum? x) (real->flonum x)]
[else (#%$app/no-inline raise-argument-error who "exact-integer?" x)]))
(define/who (fl->exact-integer fl)
(check who flonum? fl)
(inexact->exact (flfloor fl)))
(check who (lambda (x) (and (flonum? x) (flinteger? x))) :contract "(and/c flonum? integer?)" fl)
(inexact->exact fl))
(define/who (flreal-part a)
(or (and