diff options
| -rw-r--r-- | lib.c | 8 | ||||
| -rw-r--r-- | tests/012/type.tl | 48 | ||||
| -rw-r--r-- | txr.1 | 20 |
3 files changed, 66 insertions, 10 deletions
@@ -281,7 +281,7 @@ 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); + val sub_struct = if3(struct_type_p(sub), sub, 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)) @@ -294,11 +294,11 @@ val subtypep(val sub, val sup) } else if (sup == string_s) { return tnil(sub == str_s || sub == lit_s || sub == lstr_s); } else if (sup == struct_s) { - return tnil(find_struct_type(sub)); + return tnil(struct_type_p(sub) || find_struct_type(sub)); } else { { - val sub_struct = find_struct_type(sub); - val sup_struct = find_struct_type(sup); + val sub_struct = if3(struct_type_p(sub), sub, find_struct_type(sub)); + val sup_struct = if3(struct_type_p(sup), sup, find_struct_type(sup)); if (sub_struct && sup_struct) return struct_subtype_p(sub_struct, sup_struct); diff --git a/tests/012/type.tl b/tests/012/type.tl index 0cac2581..97007b3c 100644 --- a/tests/012/type.tl +++ b/tests/012/type.tl @@ -18,3 +18,51 @@ (mtest (subtypep 'stream 'stdio-stream) nil (subtypep 'stdio-stream 'stream) t) + +(defstruct xtime time) +(defstruct nottime nil) + +(mtest + (typep #S(time) 'time) t + (typep #S(time) (find-struct-type 'time)) t + (typep #S(xtime) 'time) t + (typep #S(xtime) (find-struct-type 'time)) t + (typep #S(nottime) 'time) nil + (typep #S(nottime) (find-struct-type 'time)) nil) + +(mtest + (subtypep (find-struct-type 'time) (find-struct-type 'time)) t + (subtypep (find-struct-type 'time) 'time) t + (subtypep 'time (find-struct-type 'time)) t) + +(mtest + (subtypep (find-struct-type 'xtime) (find-struct-type 'time)) t + (subtypep (find-struct-type 'xtime) 'time) t + (subtypep 'xtime (find-struct-type 'time)) t) + +(mtest + (subtypep (find-struct-type 'time) (find-struct-type 'xtime)) nil + (subtypep (find-struct-type 'time) 'xtime) nil + (subtypep 'time (find-struct-type 'xtime)) nil) + +(mtest + (subtypep 'time 'struct) t + (subtypep (find-struct-type 'time) 'struct) t + (subtypep 'hash 'struct) nil) + +(defstruct listlike nil + (:method car (me))) + +(defstruct veclike nil + (:method length (me))) + +(mtest + (subtypep 'listlike 'sequence) t + (subtypep (find-struct-type 'listlike) 'sequence) t + (subtypep 'veclike 'sequence) t + (subtypep (find-struct-type 'veclike) 'sequence) t + (subtypep 'time 'sequence) nil + (subtypep 'hash 'sequence) nil + (subtypep 'str 'sequence) t + (subtypep 'string 'sequence) t + (subtypep 'vec 'sequence) t) @@ -19203,18 +19203,26 @@ There are more kinds of objects, such as user-defined structures. .coNP Function @ subtypep .synb -.mets (subtypep < left-type-symbol << right-type-symbol ) +.mets (subtypep < left-type << right-type ) .syne .desc The .code subtypep function tests whether -.meta left-type-symbol +.meta left-type and -.meta right-type-symbol +.meta right-type name a pair of types, such that the left type is a subtype of the right type. +The arguments are either type symbols, or structure type objects, as returned by the +.code find-struct-type +function. Thus, the symbol +.codn time , +which is the name of a predefined struct type, and the object returned by +.code "(find-struct-type 'time)" +are considered equivalent argument values. + If either argument doesn't name a type, the behavior is unspecified. @@ -19222,10 +19230,10 @@ Each type is a subtype of itself. Most other type relationships can be inferred from the type hierarchy diagrams given in the introduction to this section. In addition, there are inheritance relationships among structures. If -.meta left-type-symbol +.meta left-type and -.meta right-type-symbol -both name structure types, then +.meta right-type +are both structure types, then .code subtypep yields true if the types are the same struct type, or if the right type is a direct or indirect supertype of the left. |