Chez Scheme: improve eq[v]? reductions in cptypes

Improve eq? and eq? handling to reduce expressions like
(eq? (newline) (void)) => (begin (newline) #t)

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

@@ -922,8 +922,7 @@
 ;Test types inference for string?
 (test-arg-types '(string-length string?) 'fixnum? 'may-omit)
 (test-arg-types '(string-ref string? fixnum?) 'char?)
-(unless (eq? (system-type 'vm) 'chez-scheme) ;; cptypes doesn't know that void? => eq? to (void)
+(test-arg-types '(string-set! string? fixnum? char?) 'void?)
-  (test-arg-types '(string-set! string? fixnum? char?) 'void?))
 (test-arg-types '(string->immutable-string string?) 'string? 'may-omit)
 (test-arg-types '(string-append) 'string? 'may-omit)
 (test-arg-types '(string-append string?) 'string? 'may-omit)
@@ -934,8 +933,7 @@
 ;Test types inference for bytes?
 (test-arg-types '(bytes-length bytes?) 'fixnum? 'may-omit)
 (test-arg-types '(bytes-ref bytes? fixnum?) 'fixnum?)
-(unless (eq? (system-type 'vm) 'chez-scheme) ;; cptypes doesn't know that void? => eq? to (void)
+(test-arg-types '(bytes-set! bytes? fixnum? fixnum?) 'void?)
-  (test-arg-types '(bytes-set! bytes? fixnum? fixnum?) 'void?))
 (unless (eq? (system-type 'vm) 'chez-scheme) ;; ???
   (test-arg-types '(bytes->immutable-bytes bytes?) 'bytes? 'may-omit))
 (unless (eq? (system-type 'vm) 'chez-scheme) ;; bytes-append is not primitive

racket/src/ChezScheme/mats/cptypes.ms

@@ -84,6 +84,12 @@
   (cptypes-equivalent-expansion?
     '(pair? (list)) 
     #f)
+  (cptypes-equivalent-expansion?
+    '(eq? (newline) (void))
+    '(begin (newline) #t))
+  (cptypes-equivalent-expansion?
+    '(eq? (newline) 0)
+    '(begin (newline) #f))
   (cptypes-equivalent-expansion?
     '(lambda (x) (vector-set! x 0 0) (vector? x))
     '(lambda (x) (vector-set! x 0 0) #t))
@@ -574,11 +580,12 @@
   (test-chain* '(fixnum? integer? real?))
   (test-chain* '(fixnum? exact? number?)) ; exact? may raise an error
   (test-chain* '(bignum? exact? number?)) ; exact? may raise an error
-  (test-chain* '((lambda (x) (eq? x (expt 256 100))) bignum? real? number?))
+  (test-chain '((lambda (x) (eqv? x (expt 256 100))) bignum? real? number?))
   (test-chain '((lambda (x) (eqv? 0.0 x)) flonum? real? number?))
   (test-chain* '((lambda (x) (or (eqv? x 0.0) (eqv? x 3.14))) flonum? real? number?))
   (test-chain* '((lambda (x) (or (eq? x 0) (eqv? x 3.14))) real? number?))
   (test-chain '(gensym? symbol?))
+  (test-chain '((lambda (x) (eq? x 'banana)) symbol?))
   (test-chain '(not boolean?))
   (test-chain '((lambda (x) (eq? x #t)) boolean?))
   (test-chain* '(record? #3%$record?))
@@ -594,6 +601,7 @@
   (test-disjoint '(pair? box? fixnum? flonum? (lambda (x) (eq? #t x))))
   (test-disjoint '((lambda (x) (eq? x 0)) (lambda (x) (eq? x 1)) flonum?))
   (test-disjoint '((lambda (x) (eqv? x 0.0)) (lambda (x) (eqv? x 1.0)) fixnum?))
+  (test-disjoint '((lambda (x) (eq? x 'banana)) (lambda (x) (eq? x 'apple))))
   (test-disjoint* '(list? record? vector?))
   (not (test-disjoint* '(list? null?)))
   (not (test-disjoint* '(list? pair?)))

racket/src/ChezScheme/s/cptypes.ss

@@ -826,10 +826,44 @@ Notes:
             [(_ id) (or (lookup #'id #'get-type-key)
                         ($oops 'get-type "invalid identifier ~s" #'id))])))
 
+      (define (try-compare-constants e1 e2 prim-name)
+        ; yes     => true-rec
+        ; no      => false-rec
+        ; unknown => #f
+        (and (Lsrc? e1)
+             (Lsrc? e2)
+             (nanopass-case (Lsrc Expr) e1
+               [(quote ,d1)
+                (nanopass-case (Lsrc Expr) e2
+                  [(quote ,d2)
+                   (cond
+                     [(eqv? d1 d2)
+                      (cond
+                        [(eq? prim-name 'eq?)
+                         (cond
+                           [(or (not (number? d1))
+                                ; To avoid problems with cross compilation and eq?-ness
+                                ; ensure that it's a fixnum in both machines.
+                                (and (fixnum? d1)
+                                     (target-fixnum? d1)))
+                            true-rec]
+                           [else
+                            #f])]
+                        [else
+                         true-rec])]
+                     [else
+                      false-rec])]
+                  [else #f])]
+               [else #f])))
+
       (define-specialize 2 (eq? eqv?)
         [(e1 e2) (let ([r1 (get-type e1)]
                        [r2 (get-type e2)])
                     (cond
+                      [(try-compare-constants r1 r2 prim-name)
+                       => (lambda (ret)
+                            (values (make-seq ctxt e1 e2 ret)
+                                    ret ntypes #f #f))]
                       [(predicate-disjoint? r2 r1)
                        (values (make-seq ctxt e1 e2 false-rec)
                                false-rec ntypes #f #f)]