From fdba58530a48223ecd0c9bcf629f08c3569d6c75 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 11 Dec 2019 11:42:45 -0800 Subject: OOP: implementing multiple inheritance. Multiple inheritance is too useful to ignore any longer. * lib.c (subtypep): Perform subtypep calculation between two struct types via the new struct_subtype_p function. It's too complicated now to do with ad hoc code outside of struct.c. * share/txr/stdlib/struct.tl (defstruct): This macro now needs to deal with the super argument being possibly a list of base types instead of a single one. * strut.c (struct struct_type): Member super and super_handle are removed. New member nsupers, supers, and sus. (struct_init): The super function re-registered; it has an optional argument. (call_stinitfun_chain): The compat code here must now access the supertype differently. We don't bother dealing with multiple inheritance in the compat case; programs requesting compatibility with TXR 151 shoudn't be trying to use multiple inheritance. (get_struct_handles, count_super_stslots, get_super_slots, find_super_for_slot): New static functions, to off-load some new complexity from make_struct_type. (make_struct_type): Handle the increased complexity due to multiple inheritance. (super): Takes an additional argument now, to request which supertype to retrieve. Defaults to zero: the first one. (struct_type_destroy): Free the sus array. (struct_type_mark): Mark the supers slot. (call_initfun_chain): Call init functions of all bases, in right-to-left order. (call_postinitfun_chain): Likewise for postinit functions. (call_super_method, call_super_fun, super_method): Use the first base as the supertype. This requirement feels bad; it needs to be revisited. (do_struct_subtype_p): New static function. (struct_subtype_p): New function. (ancestor_with_static_slot): New static function. (method_name): Revised for multiple inheritance; now relies on ancestor_with_static_slot to find the original ancestor that has brought in a method, so we can use that type in the method name. * struct.h (super): Declaration updated. (struct_subtype_p): Declared. * tests/012/oop-mi.expected: New file. * tests/012/oop-mi.tl: New test cases. * txr.1: Revised in order to document multiple inheritance. --- share/txr/stdlib/struct.tl | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) (limited to 'share') diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 71bcf45b..0461cd05 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -33,7 +33,7 @@ (not init-form-present))) slot-init-forms)) -(defmacro defstruct (:form form name-spec super . slot-specs) +(defmacro defstruct (:form form name-spec super-spec . slot-specs) (tree-bind (name args) (tree-case name-spec ((atom . args) (list atom args)) (atom (list atom nil))) @@ -111,12 +111,9 @@ ^(:instance ,name nil)) (name ^(:instance ,name nil))))) - (super-type (if super - (or (find-struct-type super) - (compile-defr-warning form ^(struct-type . ,super) - "inheritance base ~s \ - \ does not name a struct type" - super)))) + (supers (if (and super-spec (atom super-spec)) + (list super-spec) + super-spec)) (stat-si-forms [keep-if (op member @1 '(:static :function)) slot-init-forms car]) (pruned-si-forms (sys:prune-missing-inits stat-si-forms)) @@ -132,6 +129,12 @@ "slot name ~s isn't a bindable symbol" "invalid slot specifier syntax: ~s") bad)) + (each ((s supers)) + (or (find-struct-type s) + (compile-defr-warning form ^(struct-type . ,s) + "inheritance base ~s \ + \ does not name a struct type" + s))) (let ((arg-sym (gensym)) (type-sym (gensym))) (register-tentative-def ^(struct-type . ,name)) @@ -140,7 +143,7 @@ (each ((s inst-slots)) (register-tentative-def ^(slot . ,s))) ^(sys:make-struct-type - ',name ',super ',stat-slots ',inst-slots + ',name ',supers ',stat-slots ',inst-slots ,(if (or func-si-forms val-si-forms) ^(lambda (,arg-sym) ,*(mapcar (aret ^(when (static-slot-p ,arg-sym ',@2) -- cgit v1.2.3