From 1ad3b05213296c18352318cd620a416140a5c2ad Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 6 May 2021 07:14:52 -0600
Subject: [PATCH] cs: fix `->fl` and `fl->exact-integer` to match intended
 constraints

Fix `->fl` to work only on exact integers, and fix `fl->exact-integer`
to work only on integer flonums.
---
 pkgs/racket-test-core/tests/racket/flonum.rktl | 12 ++++++++++++
 racket/src/cs/rumble/number.ss                 | 10 +++++++---
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/flonum.rktl b/pkgs/racket-test-core/tests/racket/flonum.rktl
index 552a9c9f2e..e75b8b2e11 100644
--- a/pkgs/racket-test-core/tests/racket/flonum.rktl
+++ b/pkgs/racket-test-core/tests/racket/flonum.rktl
@@ -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[]]")
 
diff --git a/racket/src/cs/rumble/number.ss b/racket/src/cs/rumble/number.ss
index 370fb2becc..94e56e8cb2 100644
--- a/racket/src/cs/rumble/number.ss
+++ b/racket/src/cs/rumble/number.ss
@@ -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