From 6bb6981952995b511cc6f2aba2f73daf6e794636 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 6 Sep 2019 07:26:03 -0700
Subject: subtypep: structs with car or length method are sequences.

* lib.c (subtypep): For the sequence supertype, check
whether the subtype is a structure that has a length or
car method, returning t if so.

* struct.c (get_special_slot_by_type): New function.

* struct.h (get_special_slot_by_type): Declared.

* txr.1: Add <structures with cars or length methods> to the
type hierarchy diagram.
---
 lib.c    | 7 +++++++
 struct.c | 7 +++++++
 struct.h | 1 +
 txr.1    | 2 ++
 4 files changed, 17 insertions(+)

diff --git a/lib.c b/lib.c
index 99284d9f..225ea92d 100644
--- a/lib.c
+++ b/lib.c
@@ -232,6 +232,13 @@ val subtypep(val sub, val sup)
   } else if (sup == list_s) {
     return tnil(sub == null_s || sub == cons_s || sub == lcons_s);
   } else if (sup == sequence_s) {
+    val sub_struct = find_struct_type(sub);
+    if (sub_struct) {
+      if (get_special_slot_by_type(sub_struct, length_m) ||
+          get_special_slot_by_type(sub_struct, car_m))
+        return t;
+      return nil;
+    }
     return tnil(sub == str_s || sub == lit_s || sub == lstr_s ||
                 sub == vec_s || sub == null_s || sub == cons_s ||
                 sub == lcons_s || sub == list_s || sub == string_s);
diff --git a/struct.c b/struct.c
index 87ea9b96..82ea5ef4 100644
--- a/struct.c
+++ b/struct.c
@@ -1773,6 +1773,13 @@ val get_special_slot(val obj, enum special_slot spidx)
   return get_special_static_slot(si->type, spidx, slot);
 }
 
+val get_special_slot_by_type(val stype, enum special_slot spidx)
+{
+  struct struct_type *st = coerce(struct struct_type *, stype->co.handle);
+  val slot = *special_sym[spidx];
+  return get_special_static_slot(st, spidx, slot);
+}
+
 static_def(struct cobj_ops struct_type_ops =
            cobj_ops_init(eq, struct_type_print, struct_type_destroy,
                          struct_type_mark, cobj_eq_hash_op));
diff --git a/struct.h b/struct.h
index 385d8dd4..1850814e 100644
--- a/struct.h
+++ b/struct.h
@@ -87,5 +87,6 @@ val static_slot_types(val slot);
 val slot_type_reg(val slot, val strct);
 val static_slot_type_reg(val slot, val strct);
 val get_special_slot(val obj, enum special_slot spidx);
+val get_special_slot_by_type(val stype, enum special_slot spidx);
 INLINE int obj_struct_p(val obj) { return obj->co.ops == &struct_inst_ops; }
 void struct_init(void);
diff --git a/txr.1 b/txr.1
index c2ee8823..0ff054ab 100644
--- a/txr.1
+++ b/txr.1
@@ -17321,6 +17321,8 @@ brackets indicate a plurality of types which are not listed by name:
         |                |            +--- lcons
         |                |
         |                +--- vec
+        |                |
+        |                +--- <structures with car or length methods>
         |
         +--- number ---+--- float
         |              |
-- 
cgit v1.2.3