add subtyping back

1 files changed, 61 insertions, 11 deletions

diff --git a/tests/run.scm b/tests/run.scm
index cbc19f4..7ff4a6c 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -135,7 +135,7 @@
               (else #f)))))
       (test-property override (list (bytevector-generator))))))
 
-(test-group "numeric tower type expressions"
+(test-group "numeric tower subtyping"
   (define sub (make-new-SAHP))
   (define test-all-numbers
     (case-lambda
@@ -165,21 +165,36 @@
                       (sub +inf.0))))))
   (test-group "local scope"
     (test-group "type expression flow downwards"
-      (letrec-SAHP ((sub (all-numbers (lambda (x) #t))))
+      (letrec-SAHP ((sub ('number (lambda (x) #t))))
         (test-all-numbers sub)))
     (test-group "subtypes do not flow upwards"
-      (letrec-SAHP ((sub (all-exact-rationals (lambda (x) #t))))
+      (letrec-SAHP ((sub ('exact-rational (lambda (x) #t))))
         (test-some-numbers sub))))
   (test-group "dynamic scope"
     (test-group "subtypes flow downwards"
-      (parameterize-SAHP ((sub (all-numbers (lambda (x) #t))))
+      (parameterize-SAHP ((sub ('number (lambda (x) #t))))
         (test-all-numbers sub)))
     (test-group "subtypes do not flow upwards"
-      (parameterize-SAHP ((sub (all-exact-rationals (lambda (x) #t))))
+      (parameterize-SAHP ((sub ('exact-rational (lambda (x) #t))))
         (test-some-numbers sub)))
     (test-group "local scope overrides dynamic scope subtyping"
-      (parameterize-SAHP ((sub (all-numbers (lambda (x) 1))))
-        (letrec-SAHP ((sub (all-exact-rationals (lambda (x) 2))))
+      (parameterize-SAHP ((sub ('number (lambda (x) 1))))
+        (letrec-SAHP ((sub ('exact-rational (lambda (x) 2))))
+          (define (test-local n)
+            (= 2 (sub n)))
+          (define (test-dynamic n)
+            (= 1 (sub n)))
+          (test-group "local"
+            (test-property test-local
+                           (list
+                            (gsampling (exact-rational-generator)))))
+          (test-group "dynamic"
+            (test-property test-dynamic
+                           (list
+                            (gsampling (inexact-complex-generator))))))))
+    (test-group "local scope overrides dynamic scope subtyping even with overridable"
+      (parameterize-SAHP ((sub ('number (lambda (x) 1))))
+        (letrec-SAHP ((sub ('exact-rational 'overridable (lambda (x) 2))))
           (define (test-local n)
             (= 2 (sub n)))
           (define (test-dynamic n)
@@ -193,7 +208,7 @@
                            (list
                             (gsampling (inexact-complex-generator)))))))))
   (test-group "global scope"
-    (define-global-SAHP (sub (all-numbers x))
+    (define-global-SAHP (sub ('number x))
       1)
     (define (test-global n)
       (= 1 (sub n)))
@@ -202,7 +217,17 @@
     (test-group "subtypes flow downwards"
       (test-all-numbers))
     (test-group "dynamic scope overrides global scope"
-      (parameterize-SAHP ((sub (all-exact-rationals (lambda (x) 2))))
+      (parameterize-SAHP ((sub ('exact-rational (lambda (x) 2))))
+        (test-group "dynamic"
+          (test-property test-dynamic
+                         (list
+                          (gsampling (exact-rational-generator)))))
+        (test-group "global"
+          (test-property test-global
+                         (list
+                          (gsampling (inexact-complex-generator)))))))
+    (test-group "dynamic scope overrides global scope even with overridable"
+      (parameterize-SAHP ((sub ('exact-rational 'overridable (lambda (x) 2))))
         (test-group "dynamic"
           (test-property test-dynamic
                          (list
@@ -212,8 +237,31 @@
                          (list
                           (gsampling (inexact-complex-generator)))))))
     (test-group "local scope overrides dynamic scope overrides global scope"
-      (parameterize-SAHP ((sub (all-exact-rationals (lambda (x) 2))))
-        (letrec-SAHP ((sub (all-exact-integers (lambda (x) 3))))
+      (parameterize-SAHP ((sub ('exact-rational (lambda (x) 2))))
+        (letrec-SAHP ((sub ('exact-integer (lambda (x) 3))))
+          (define (test-local n)
+            (= 3 (sub n)))
+          (test-group "dynamic"
+            (test-property test-dynamic
+                           (list
+                            (gsampling (exact-rational-generator)))))
+          (test-group "global"
+            (test-property test-global
+                           (list
+                            (gsampling (inexact-complex-generator)))))
+          (test-group "local"
+            (test-property test-local
+                           (list
+                            (gsampling (exact-integer-generator))))))))
+    (test-group "local scope overrides dynamic scope overrides global scope even when overridable"
+      (parameterize-SAHP ((sub
+                           ('exact-rational
+                            'overridable
+                            (lambda (x) 2))))
+        (letrec-SAHP ((sub
+                       ('exact-integer
+                        'overridable
+                        (lambda (x) 3))))
           (define (test-local n)
             (= 3 (sub n)))
           (test-group "dynamic"
@@ -228,3 +276,5 @@
             (test-property test-local
                            (list
                             (gsampling (exact-integer-generator))))))))))
+
+;;; TODO: tests of override