summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2019-09-06 07:26:03 -0700
committerKaz Kylheku <kaz@kylheku.com>2019-09-06 07:26:03 -0700
commit78d6a6ed5cd8a141fdae8e7f85faeadbd5b177b2 (patch)
tree21e39400f7f201524f08ff7bdf71cdb17dfaa4c0
parent1a444721869bca8f94f1a5370b9d177444e35ea8 (diff)
downloadtxr-78d6a6ed5cd8a141fdae8e7f85faeadbd5b177b2.tar.gz
txr-78d6a6ed5cd8a141fdae8e7f85faeadbd5b177b2.tar.bz2
txr-78d6a6ed5cd8a141fdae8e7f85faeadbd5b177b2.zip
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.
-rw-r--r--lib.c7
-rw-r--r--struct.c7
-rw-r--r--struct.h1
-rw-r--r--txr.12
4 files changed, 17 insertions, 0 deletions
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
| |