Chez Scheme: fix too much propagation of numbers in cptypes

In this example, after the check with eq? or eqv? the value of
the variables x and y are known, so cptypes replaced the
reference to the variable with it. But it can interact badly
with the eq? test, for example in this case the first (eq? x y)
can be #f and the second be reduced by the compiler to #t.

In spite eq? cannot be used to compare numbers reliably, this
behavior is too confusing and it's better to avoid it.

(define (one)
  (let ([r (random 2)])
    (if (= r 0) (one) r)))

(define (f x y)
  (define first-comparison (eq? x y))
    (when (and (eqv? x 7.0)
               (eqv? y 7.0))
      (define second-comparison (eq? x y))
      (eq? first-comparison second-comparison)))

(f (+ 6.0 (one)) (+ 6.0 (one)))))

pkgs/racket-test-core/tests/racket/optimize.rktl

@@ -7109,6 +7109,26 @@
                      loop)])
          h)))))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Regression test related to propagation of flonums
+;; from eqv? tests in CS
+
+(test #t
+      (lambda ()
+        ; optimizer unfriendly 1
+        (define (one)
+          (let ([r (random 2)])
+            (if (= r 0) (one) r)))
+
+        (define (f x y)
+          (define first-comparison (eq? x y))
+          (when (and (eqv? x 7.0)
+                     (eqv? y 7.0))
+            (define second-comparison (eq? x y))
+            (eq? first-comparison second-comparison)))
+
+        (f (+ 6.0 (one)) (+ 6.0 (one)))))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (report-errs)

racket/src/ChezScheme/s/cptypes.ss

@@ -1476,6 +1476,11 @@ Notes:
               [(Lsrc? t)
                (nanopass-case (Lsrc Expr) t
                  [(quote ,d)
+                  (guard (or (not (number? d))
+                             ; To avoid problems with cross compilation and eq?-ness
+                             ; ensure that it's a fixnum in both machines.
+                             (and (fixnum? d)
+                                  (target-fixnum? d))))
                   (values t t types #f #f)]
                  [else
                   (values ir t types #f #f)])]