From b1fe95fef05b7e8d26ff82645d373c2ef0b5c449 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Thu, 12 Dec 2019 18:10:17 -0800
Subject: multiple-inheritance: super-method loose ends.

* struct.c (do_super): New function. Now the common
implementation for call_super_method, call_super_fun and
super_method.
(call_super_method, call_super_fun): Reduced to small wrappers
around do_super.
(super_method): Drill into the object to geet the struct_type
handle, and then use do_super to get the method.

* tests/012/oop-mi.tl: New tests for call-super-fun and
call-super-method.

* tests/012/oop-mi.expected: Updated.

* txr.1: Updated.
---
 struct.c | 71 ++++++++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 45 insertions(+), 26 deletions(-)

(limited to 'struct.c')

diff --git a/struct.c b/struct.c
index d549a869..f68585e3 100644
--- a/struct.c
+++ b/struct.c
@@ -1396,39 +1396,56 @@ val static_slot_home(val stype, val sym)
   no_such_static_slot(self, stype, sym);
 }
 
-static val call_super_method(val inst, val sym, struct args *args)
+static val do_super(struct struct_type *st,
+                    val inst, val sym, val self,
+                    struct args *args)
 {
-  val type = struct_type(inst);
-  val suptype = super(type, zero);
+  val type = st->self;
+  cnum i;
 
-  if (suptype) {
-    val meth = static_slot(suptype, sym);
-    args_decl(args_copy, max(args->fill + 1, ARGS_MIN));
-    args_add(args_copy, inst);
-    args_cat_zap(args_copy, args);
-    return generic_funcall(meth, args_copy);
+  for (i = 0; i < st->nsupers; i++) {
+    struct struct_type *su = st->sus[i];
+    loc ptr = lookup_static_slot_load(su, sym);
+    if (!nullocp(ptr)) {
+      val meth = deref(ptr);
+      if (inst == t) {
+        return meth;
+      } else if (inst) {
+        args_decl(args_copy, max(args->fill + 1, ARGS_MIN));
+        args_add(args_copy, inst);
+        args_cat_zap(args_copy, args);
+        return generic_funcall(meth, args_copy);
+      } else {
+        return generic_funcall(meth, args);
+      }
+    }
   }
 
-  uw_throwf(error_s, lit("call-super-method: ~s has no supertype"),
-            suptype, nao);
+  if (st->nsupers)
+    if (bindable(sym))
+      uw_throwf(error_s, lit("~s: slot ~s not found among supertypes of ~s"),
+                self, sym, type, nao);
+    else
+      uw_throwf(error_s, lit("~s: ~s isn't a valid slot name"),
+                self, sym);
+  else
+    uw_throwf(error_s, lit("~s: ~s has no supertype"),
+              type, nao);
+}
+
+static val call_super_method(val inst, val sym, struct args *args)
+{
+  val type = struct_type(inst);
+  val self = lit("call-super-method");
+  struct struct_type *st = stype_handle(&type, self);
+  return do_super(st, inst, sym, self, args);
 }
 
 static val call_super_fun(val type, val sym, struct args *args)
 {
   val self = lit("call-super-fun");
   struct struct_type *st = stype_handle(&type, self);
-
-  if (st->nsupers) {
-    val suptype = st->sus[0]->self;
-
-    if (suptype) {
-      val fun = static_slot(suptype, sym);
-      return generic_funcall(fun, args);
-    }
-  }
-
-  uw_throwf(error_s, lit("~a: ~s has no supertype"),
-            self, type, nao);
+  return do_super(st, nil, sym, self, args);
 }
 
 val slotp(val type, val sym)
@@ -1540,11 +1557,13 @@ val method_args(val strct, val slotsym, struct args *args)
                          cons(slot(strct, slotsym), strct)), method_args_fun);
 }
 
-
 val super_method(val strct, val slotsym)
 {
-  val super_slot = static_slot(super(struct_type(strct), zero), slotsym);
-  return func_f0v(cons(super_slot, strct), method_fun);
+  val type = struct_type(strct);
+  val self = lit("super-method");
+  struct struct_type *st = stype_handle(&type, self);
+  val meth = do_super(st, t, slotsym, self, 0);
+  return func_f0v(cons(meth, strct), method_fun);
 }
 
 static val uslot_fun(val sym, val strct)
-- 
cgit v1.2.3