New function: static-slot-home.

* struct.c (struct_init): Register intrinsic function
static-slot-home.
(lookup_static_slot_desc_load): New static function.
(static_slot_home): New function.

* struct.h (static_slot_home): Declared.

* txr.1: Documented.

3 files changed, 61 insertions, 0 deletions

diff --git a/struct.c b/struct.c
index eeac788d..a4e9eb8f 100644
--- a/struct.c
+++ b/struct.c
@@ -150,6 +150,8 @@ void struct_init(void)
   reg_fun(intern(lit("clear-dirty"), user_package), func_n1(clear_dirty));
   reg_fun(intern(lit("static-slot-ensure"), user_package),
           func_n4o(static_slot_ensure, 3));
+  reg_fun(intern(lit("static-slot-home"), user_package),
+          func_n2(static_slot_home));
   reg_fun(intern(lit("call-super-method"), user_package),
           func_n2v(call_super_method));
   reg_fun(intern(lit("call-super-fun"), user_package),
@@ -861,6 +863,17 @@ static loc lookup_static_slot_load(struct struct_type *st, val sym)
   return ptr;
 }
 
+static struct stslot *lookup_static_slot_desc_load(struct struct_type *st,
+                                                   val sym)
+{
+  struct stslot *stsl = lookup_static_slot_desc(st, sym);
+  if (stsl == 0) {
+    lisplib_try_load(sym);
+    return lookup_static_slot_desc(st, sym);
+  }
+  return stsl;
+}
+
 static noreturn void no_such_slot(val ctx, val type, val slot)
 {
   uw_throwf(error_s, lit("~a: ~s has no slot named ~s"),
@@ -1114,6 +1127,19 @@ val static_slot_ensure(val stype, val sym, val newval, val no_error_p)
   return static_slot_ens_rec(stype, sym, newval, no_error_p, self, 0);
 }
 
+val static_slot_home(val stype, val sym)
+{
+  val self = lit("static-slot-home");
+  struct struct_type *st = stype_handle(&stype, self);
+  struct stslot *stsl = lookup_static_slot_desc_load(st, sym);
+  if (stsl) {
+    val home = stsl->home_type;
+    struct struct_type *sh = stype_handle(&home, self);
+    return sh->name;
+  }
+  no_such_static_slot(self, stype, sym);
+}
+
 static val call_super_method(val inst, val sym, struct args *args)
 {
   val type = struct_type(inst);
diff --git a/struct.h b/struct.h
index 27e13621..d7f30f0d 100644
--- a/struct.h
+++ b/struct.h
@@ -48,6 +48,7 @@ val slotset(val strct, val sym, val newval);
 val static_slot(val stype, val sym);
 val static_slot_set(val stype, val sym, val newval);
 val static_slot_ensure(val stype, val sym, val newval, val no_error_p);
+val static_slot_home(val stype, val sym);
 val test_dirty(val strct);
 val test_clear_dirty(val strct);
 val clear_dirty(val strct);
diff --git a/txr.1 b/txr.1
index 01bdb16b..20186fa0 100644
--- a/txr.1
+++ b/txr.1
@@ -23971,6 +23971,40 @@ which already have a slot called
 .meta name
 are ignored, as are their subtypes.
 
+.coNP Function @ static-slot-home
+.synb
+.mets (static-slot-ensure < type << name )
+.syne
+.desc
+The
+.code static-slot-home
+method determines which structure type actually defines the
+static slot
+.meta name
+present in struct type
+.metn type .
+
+If
+.meta type
+isn't a struct type, or the name of a struct type,
+the function throws an error. Likewise, if
+.meta name
+isn't a static slot of
+.metn type .
+
+If
+.meta name
+is a static slot of
+.meta type
+then the function returns a struct type name symbol which is either
+then name of
+.meta type
+itself, if the slot is defined specifically for
+.meta type
+or else the most distant ancestor of
+.meta type
+from which the slot is inherited.
+
 .coNP Function @ call-super-method
 .synb
 .mets (call-super-method < struct-obj < name << argument *)