From fdba58530a48223ecd0c9bcf629f08c3569d6c75 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
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.
---
 tests/012/oop-mi.expected |  8 ++++++++
 tests/012/oop-mi.tl       | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 tests/012/oop-mi.expected
 create mode 100644 tests/012/oop-mi.tl

(limited to 'tests')

diff --git a/tests/012/oop-mi.expected b/tests/012/oop-mi.expected
new file mode 100644
index 00000000..91bc05df
--- /dev/null
+++ b/tests/012/oop-mi.expected
@@ -0,0 +1,8 @@
+#S(der0 gx gx gy dgy x dx y dy z dz)
+dgs0
+gs1-b1
+#S(der1 x b3x gx b3gx gy gy y b2y)
+gs0
+gs1-b1
+(meth base3 b3m0)
+(meth der1 b3m1)
diff --git a/tests/012/oop-mi.tl b/tests/012/oop-mi.tl
new file mode 100644
index 00000000..162c0243
--- /dev/null
+++ b/tests/012/oop-mi.tl
@@ -0,0 +1,47 @@
+(load "../common")
+
+(defstruct grand nil
+  (gx 'gx)
+  (gy 'gy)
+  (:static gs0 'gs0)
+  (:static gs1 'gs1))
+
+(defstruct base0 nil)
+
+(defstruct base1 grand
+  (x 'b1x)
+  (:static gs1 'gs1-b1))
+
+(defstruct base2 grand
+  (y 'b2y)
+  (:static gs1 'gs1-b2))
+
+(defstruct base3 nil
+  (x 'b3x)
+  (gx 'b3gx)
+  (:method b3m0 (me))
+  (:method b3m1 (me)))
+
+(defstruct der0 (base0 base1 base2 base3)
+  (x 'dx)
+  (y 'dy)
+  (z 'dz)
+  (gy 'dgy)
+  (:static gs0 'dgs0))
+
+(defstruct der1 (base3 base1 base2)
+  (:method b3m1 (me)))
+
+(defvarl d0 (new der0))
+(defvarl d1 (new der1))
+
+(prinl d0)
+(prinl d0.gs0)
+(prinl d0.gs1)
+
+(prinl d1)
+(prinl d1.gs0)
+(prinl d1.gs1)
+
+(prinl (func-get-name d0.b3m0))
+(prinl (func-get-name d1.b3m1))
-- 
cgit v1.2.3