Update more tests in cptypes.ms

cisco · Jan 8, 2024 · 48555c3 · 48555c3
1 parent 8044b41
commit 48555c3
Showing 1 changed file with 29 additions and 0 deletions.
diff --git a/mats/cptypes.ms b/mats/cptypes.ms
@@ -878,16 +878,45 @@
                    (add1 x)))
     '(lambda (x) (when (flonum? x)
                    (#3%fl+ x 1.0))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (fixnum? x)
+                   (let ([y (sub1 x)])
+                     (and (integer? y) (exact? y)))))
+    '(lambda (x) (when (fixnum? x)
+                   (let ([y (sub1 x)])
+                     #t))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (real? x)
+                   (real? (sub1 x))))
+    '(lambda (x) (when (real? x)
+                   #t)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x)
+                   (flonum? (sub1 x))))
+    '(lambda (x) (when (flonum? x)
+                   #t)))
   (cptypes-equivalent-expansion?
     '(lambda (x) (when (flonum? x)
                    (sub1 x)))
     '(lambda (x) (when (flonum? x)
                    (#3%fl- x 1.0))))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (fixnum? x)
+                   (let ([y (abs x)])
+                     (and (integer? y) (exact? y)))))
+    '(lambda (x) (when (fixnum? x)
+                   (let ([y (abs x)])
+                     #t))))
   (cptypes-equivalent-expansion?
     '(lambda (x) (when (real? x)
                    (real? (abs x))))
     '(lambda (x) (when (real? x)
                    #t)))
+  (cptypes-equivalent-expansion?
+    '(lambda (x) (when (flonum? x)
+                   (flonum? (abs x))))
+    '(lambda (x) (when (flonum? x)
+                   #t)))
 )
 
 (mat cptypes-rest-argument