Add a few improvements for predicates in cptype, in particular for zero? (cisco#960)

* Allow #f and (void) as results of primitive handlers in cptypes

The speciliation handlers can return #f or (void)
in case they don't want to make changes, and then
the default is used.

The use of #f is similar to `define-inline` in cp0,
but (void) allows to use `when`or `cond` to select
the useful cases.

* Improve predicates handling in cptype

When a primitive is marked as a predicate and has a
handler, then try to reduce it as a predicate and then
call the handler for more specific reductions.

* Add rational? to cptypes

* Improve support of zero? in cptypes

In particular, reduce

(if (zero? x) (zero? x) (zero? x))
=>
(if (zero? x) #t #f)
=>
(zero? x)

* Track 0.0 and -0.0 in cptypes

It useful to reduce

(cond
  [(eqv? x 0.0) ...]
  [(eqv? x -0.0) ...]
  [(flzero? x) ...] ; this can be eliminated
  [...])

Author: gus-massa

mats/cptypes.ms

@@ -608,6 +608,12 @@
 (define (test-chain*/preamble l)
   (test-chain/preamble/self preamble #f l))
 
+(define (test-all-imply l* p)
+  (andmap (lambda (l) (test-chain (list l p))) l*))
+
+(define (test-all-imply* l* p)
+  (andmap (lambda (l) (test-chain* (list l p))) l*))
+
 (define (test-disjoint/preamble/self preamble check-self? l)
   (let loop ([l l])
     (if (null? l)
@@ -663,6 +669,8 @@
   (test-chain '((lambda (x) (eqv? 0.0 x)) flonum? cflonum? 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* '(fixnum? rational? real?))
+  (test-chain* '(flzero? rational? real?))
   (test-chain '(gensym? symbol?))
   (test-chain '((lambda (x) (eq? x 'banana)) symbol?))
   (test-chain '(not boolean?))
@@ -683,6 +691,8 @@
   (test-disjoint '(integer? ratnum?))
   (test-disjoint '((lambda (x) (eq? x 'banana)) (lambda (x) (eq? x 'apple))))
   (test-disjoint* '(list? record? vector?))
+  (test-all-imply* '(rational? finite?) 'real?)
+  (test-all-imply* '(infinite? nan? flfinite? flinfinite? flnan?) 'flonum?)
 )
 
 ; use a gensym to make expansions equivalent
@@ -900,6 +910,15 @@
   (cptypes-equivalent-expansion?
     '(lambda (x) (when (fixnum? x) (fxzero? x)))
     '(lambda (x) (when (fixnum? x) (#3%fxzero? x))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (if (zero? x) (zero? x) (zero? x)))
+    '(lambda (x) (if (zero? x) #t #f)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (if (flzero? x) (or (eqv? x -0.0) (eqv? x 0.0)) (or (eqv? x -0.0) (eqv? x 0.0))))
+    '(lambda (x) (if (flzero? x) #t #f)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x) (if (or (eqv? x -0.0) (eqv? x 0.0)) (flzero? x) (flzero? x))))
+    '(lambda (x) (when (flonum? x) (if (or (eqv? x -0.0) (eqv? x 0.0)) #t #f))))
   (not (cptypes-equivalent-expansion?
          '(lambda (x) (when (number? x) (#2%odd? x)))
          '(lambda (x) (when (number? x) (#3%odd? x)))))
@@ -909,6 +928,24 @@
   (not (cptypes-equivalent-expansion?
          '(lambda (x) (#2%exact? x))
          '(lambda (x) (#3%exact? x))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (fixnum? x) (integer? x)))
+    '(lambda (x) (when (fixnum? x) #t)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (null? x) (integer? x)))
+    '(lambda (x) (when (null? x) #f)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x) (#2%integer? x)))
+    '(lambda (x) (when (flonum? x) (#3%flinteger? x))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x) (#2%rational? x)))
+    '(lambda (x) (when (flonum? x) (#3%flfinite? x))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (real? x) (#2%finite? x)))
+    '(lambda (x) (when (real? x) (#3%finite? x))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x) (#2%finite? x)))
+    '(lambda (x) (when (flonum? x) (#3%flfinite? x))))
   (cptypes-equivalent-expansion?
     '(lambda (x) (when (fixnum? x)
                    (add1 x)))

mats/primvars.ms

@@ -418,11 +418,15 @@
               [(fasl-strip-options) (fasl-strip-options inspector-source) (file-options compressed) #f]
               [(file-options) (file-options compressed) 1/2 #f]
               [(fixnum) -1 'q (+ (most-positive-fixnum) 1) (- (most-negative-fixnum) 1) #f]
+              [(flinteger) 0.0 0 0.5 0.0+1.0i 'a #f]
               [(flonum) 0.0 0 0.0+1.0i 'a #f]
+              [(flrational) 0.5 1/2 1+2i +inf.0 #f]
+              [(flvector) '#vfl(0.0) "a" #f]
+              [(flzero) 0.0 0 "a" #f]
               [(ftype-pointer) *ftype-pointer 0 *time #f]
               [(sub-ftype-pointer) no-good]
               [(fxvector) '#vfx(0) "a" #f]
-              [(flvector) '#vfl(0.0) "a" #f]
+              [(fxzero) 0 0.0 "a" #f]
               [(gensym) *genny 'sym #f]
               [(guardian) (make-guardian) values "oops" #f]
               [(hashtable) *eq-hashtable '((a . b)) #f]
@@ -432,6 +436,7 @@
               [(immutable-string) *immutable-string "a" 'a #f]
               [(immutable-vector) *immutable-vector '#(a) "a" #f]
               [(import-spec) '(chezscheme) 0 '(a . b) #f]
+              [(infinite) +inf.0 +nan.0 +inf.0+inf.0i 0.0 0 "a" #f]
               [(input-port) (current-input-port) 0 *binary-output-port *textual-output-port #f]
               [(integer) 0.0 1/2 1.0+0.0i 'a #f]
               [(i/o-encoding-error) (make-i/o-encoding-error 17 23) (make-who-condition 'who) 1/2 #f]
@@ -462,6 +467,7 @@
               [(maybe-who) 'who 17]
               [(maybe-timeout) *time 371]
               [(message-condition) (make-message-condition 17) (make-who-condition 'who) 'q #f]
+              [(nan) +nan.0 +inf.0 +nan.0+nan.0i 0.0 0 "a" #f]
               [(nonempty-bytevector) '#vu8(0) '#vu8() "a" #f]
               [(nonempty-flvector) '#vfl(0.0) '#vfl() "a" #f]
               [(nonempty-fxvector) '#vfx(0) '#vfx() "a" #f]
@@ -528,6 +534,7 @@
               [(vector) '#(a) "a" #f]
               [(stencil-vector) (stencil-vector 7 1 2 3) "a" #f]
               [(who-condition) (make-who-condition 'me) (make-message-condition "hello") 'the-who #f]
+              [(zero) 0 1 1.0 "a" #f]
               [($exactnum) 1+1i 1.0+1.0i 1 1.0 'a #f]
               [($inexactnum) 1.0+1.0i 1+1i 1 1.0 'a #f])
             (meta-cond

release_notes/release_notes.stex

@@ -137,7 +137,8 @@ and \scheme{inexact?}, .
 \subsection{Type recovery improvements (10.3.0)}
 
 The type recovery pass has improved support for \scheme{cfl+} and
-similar functions.
+similar functions. Also improve the support of predicates, in
+particular integer?, zero? and similar predicates.
 
 \subsection{Unicode 16.0.0 support (10.3.0)}