From 618a854df42cb43e410ba488a6634dae16a3e36f Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 9 Jul 2021 07:42:28 -0700
Subject: subtypep: handle COBJ inheritance.

* lib.c (class_from_sym): New static function.
(subtypep): Remove special case handling of stream versus
stdio-stream. If the two types are not both structures, then
check whether they are both cobj classes. If so, check if they
are in an inheritance relationship via the cobj_hash.
(cobj_populate_hash): Map each symbol to a fixnum integer
which gives class handle'position in the cobj_class table.
(cobj_class_exists): Style: compare to nil instead of 0.
(obj_init): Do not call cobj_populate_hash here, it is far too
early: only a couple of COBJ types exist at this point.
Moreover, hash_init has not been called so hash_cls and
hash_iter_cls still have null symbols.
(init): Call obj_populate_hash here, as the last step.

* tests/012/type.tl: New file.
---
 lib.c             | 40 ++++++++++++++++++++++++++++++----------
 tests/012/type.tl | 20 ++++++++++++++++++++
 2 files changed, 50 insertions(+), 10 deletions(-)
 create mode 100644 tests/012/type.tl

diff --git a/lib.c b/lib.c
index d90ab1de..06f2ba71 100644
--- a/lib.c
+++ b/lib.c
@@ -252,6 +252,12 @@ val typeof(val obj)
   }
 }
 
+static struct cobj_class *class_from_sym(val cls_sym)
+{
+  val idx = gethash(cobj_hash, cls_sym);
+  return idx ? cobj_class + c_n(idx) : 0;
+}
+
 val subtypep(val sub, val sup)
 {
   if (sub == sup) {
@@ -284,16 +290,30 @@ val subtypep(val sub, val sup)
                 sub == lcons_s || sub == list_s || sub == string_s);
   } else if (sup == string_s) {
     return tnil(sub == str_s || sub == lit_s || sub == lstr_s);
-  } else if (sup == stream_s) {
-    return tnil(sub == stdio_stream_s);
   } else if (sup == struct_s) {
     return tnil(find_struct_type(sub));
   } else {
-    val sub_struct = find_struct_type(sub);
-    val sup_struct = find_struct_type(sup);
+    {
+      val sub_struct = find_struct_type(sub);
+      val sup_struct = find_struct_type(sup);
+
+      if (sub_struct && sup_struct)
+        return struct_subtype_p(sub_struct, sup_struct);
+    }
+
+    {
+      struct cobj_class *sub_cls = class_from_sym(sub);
+      struct cobj_class *sup_cls = class_from_sym(sup);
 
-    if (sub_struct && sup_struct)
-      return struct_subtype_p(sub_struct, sup_struct);
+      if (sub_cls && sup_cls) {
+        struct cobj_class *pcls = sub_cls;
+        do {
+          if (pcls == sup_cls)
+            return t;
+          pcls = pcls->super;
+        } while (pcls);
+      }
+    }
 
     return nil;
   }
@@ -9183,12 +9203,12 @@ static void cobj_populate_hash(void)
 {
   struct cobj_class *ptr;
   for (ptr = cobj_class; ptr < cobj_ptr; ptr++)
-    sethash(cobj_hash, ptr->cls_sym, ptr->cls_sym);
+    sethash(cobj_hash, ptr->cls_sym, num_fast(ptr - cobj_class));
 }
 
 int cobj_class_exists(val cls_sym)
 {
-  return gethash(cobj_hash, cls_sym) != 0;
+  return gethash(cobj_hash, cls_sym) != nil;
 }
 
 val cobj(mem_t *handle, struct cobj_class *cls, struct cobj_ops *ops)
@@ -12667,8 +12687,6 @@ static void obj_init(void)
   prog_string = string(progname);
 
   cobj_hash = make_hash(nil, nil, nil);
-
-  cobj_populate_hash();
 }
 
 static val simple_qref_args_p(val args, val pos)
@@ -13916,6 +13934,8 @@ void init(val *stack_bottom)
   time_init();
   chksum_init();
 
+  cobj_populate_hash();
+
   gc_state(gc_save);
 }
 
diff --git a/tests/012/type.tl b/tests/012/type.tl
new file mode 100644
index 00000000..0cac2581
--- /dev/null
+++ b/tests/012/type.tl
@@ -0,0 +1,20 @@
+(load "../common")
+
+(mtest
+  (subtypep 'a 'a) t
+  (subtypep t t) t
+  (subtypep nil t) t
+  (subtypep t nil) nil
+  (subtypep nil nil) t
+  (subtypep 'null nil) nil
+  (subtypep nil 'null) t
+  (subtypep 'null t) t
+  (subtypep 'null 'a) nil
+  (subtypep 'a 'null) nil
+  (subtypep nil 'a) t
+  (subtypep 'a nil) nil
+  (subtypep 'a t) t)
+
+(mtest
+  (subtypep 'stream 'stdio-stream) nil
+  (subtypep 'stdio-stream 'stream) t)
-- 
cgit v1.2.3