Make subtype fn of <?> behaves like (</> (<Assortment> #f) ...)

shirok · Feb 7, 2025 · 2b8d186 · 2b8d186
1 parent 28ad8c0
commit 2b8d186
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 1 deletion.
diff --git a/src/libtype.scm b/src/libtype.scm
@@ -619,7 +619,8 @@
   :subtype? (^[type super]
               (if (is-a? super <?>)
                 (subtype? (~ type'primary-type) (~ super'primary-type))
-                'super))
+                (and (of-type? #f super)
+                     (subtype? (~ type'primary-type) super))))
   :supertype? (^[type sub] (subtype? sub (~ type'primary-type))))
 
 ;;;

diff --git a/test/type.scm b/test/type.scm
@@ -87,7 +87,10 @@
 (t-subtype <real>    (<?> <integer>) #f)
 (t-subtype (<?> <integer>) (<?> <real>) #t)
 (t-subtype (<?> <integer>) <integer> #f)
+(t-subtype (<?> <boolean>) <boolean> #t)
 (t-subtype (<?> <integer>) (</> (<?> <number>) (<?> <string>)) #t)
+(t-subtype (<?> <char>) (</> <boolean> <char>) #t)
+(t-subtype (<?> <char>) (</> <integer> <char>) #f)
 
 (t-subtype (<Tuple> <integer> <string>) <list> #t)
 (t-subtype (<Tuple> <integer> <string>) (<Tuple> <integer> <string>) #t)
@@ -139,6 +142,8 @@
 (t-subtype (<Assortment> 1 3) <integer> #t)
 (t-subtype (<Assortment> 1 'a) (</> <integer> <symbol>) #t)
 (t-subtype (<Assortment> 1 'a) (</> <integer> <string>) #f)
+(t-subtype (</> (<Assortment> #f) <char>) (<?> <char>) #t)
+(t-subtype (<?> <char>) (</> (<Assortment> #f) <char>) #t)
 
 (test-section "built-in type constructors")