From 2b8d1865633c7424f950517c03ca7483d68d4432 Mon Sep 17 00:00:00 2001
From: kaki <gengar@users.noreply.github.com>
Date: Thu, 6 Feb 2025 21:25:35 +0900
Subject: [PATCH] Make subtype fn of <?> behaves like (</> (<Assortment> #f)
 ...)

---
 src/libtype.scm | 3 ++-
 test/type.scm   | 5 +++++
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/src/libtype.scm b/src/libtype.scm
index 4be0fb727..0bd91a9f3 100644
--- 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
index 874be171c..addb23f88 100644
--- 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")