New super-method function.

* struct.c (struct_init): Register super-method.
(super_method): New function.

* struct.h (super_method): Declared.

* txr.1: Documented.

3 files changed, 40 insertions, 1 deletions

diff --git a/struct.c b/struct.c
index c520f493..9de7d0c5 100644
--- a/struct.c
+++ b/struct.c
@@ -125,6 +125,7 @@ void struct_init(void)
   reg_fun(intern(lit("structp"), user_package), func_n1(structp));
   reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type));
   reg_fun(intern(lit("method"), user_package), func_n2(method));
+  reg_fun(intern(lit("super-method"), user_package), func_n2(super_method));
 }
 
 static noreturn void no_such_struct(val ctx, val sym)
@@ -679,6 +680,12 @@ val method(val strct, val slotsym)
   return func_f0v(cons(slot(strct, slotsym), strct), method_fun);
 }
 
+val super_method(val strct, val slotsym)
+{
+  val super_slot = static_slot(super(struct_type(strct)), slotsym);
+  return func_f0v(cons(super_slot, strct), method_fun);
+}
+
 static void struct_inst_print(val obj, val out, val pretty)
 {
   struct struct_inst *si = coerce(struct struct_inst *, obj->co.handle);
diff --git a/struct.h b/struct.h
index d0bc9c85..7e4009c3 100644
--- a/struct.h
+++ b/struct.h
@@ -41,5 +41,6 @@ val slot_p(val type, val sym);
 val static_slot_p(val type, val sym);
 val structp(val obj);
 val struct_type(val strct);
-val method(val strct, val obj);
+val method(val strct, val slotsym);
+val super_method(val strct, val slotsym);
 void struct_init(void);
diff --git a/txr.1 b/txr.1
index 1596ab73..e2f631a4 100644
--- a/txr.1
+++ b/txr.1
@@ -18561,6 +18561,37 @@ Note: the
 macro is an alternative interface which is suitable if
 the slot name isn't a computed value.
 
+.coNP Function @ super-method
+.synb
+.mets (super-method < struct-obj << slot-name )
+.syne
+.desc
+The
+.code super-method
+function retrieves a function from a static
+slot belonging to the supertype of the structure type of
+.metn struct-obj .
+
+It then returns a function which binds
+that function's left argument to the structure.
+
+The
+.meta struct-obj
+argument must be a structure which has a supertype, and
+.meta slot-name
+must be a symbol denoting a static slot in that supertype.
+The slot must hold a function of at least one
+argument.
+
+The
+.code super-method
+function returns a function which, when invoked,
+calls the function previously retrieved from
+the supertype's static slot, passing to that function
+.meta struct-obj
+as the leftmost argument, followed by the function's
+own arguments.
+
 .coNP Function @ slot-p
 .synb
 .mets (slot-p < type << name )