oop: new function: struct-type-name.

* struct.c (struct_init): Register struct-type-name intrinsic.
(struct_type_name): New function.

* struct.h (struct_type_name): Declared.

* txr.1: Documented.

3 files changed, 22 insertions, 0 deletions

diff --git a/struct.c b/struct.c
index 48f961b6..4810d6e5 100644
--- a/struct.c
+++ b/struct.c
@@ -184,6 +184,7 @@ void struct_init(void)
   reg_fun(intern(lit("static-slot-p"), user_package), func_n2(static_slot_p));
   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("struct-type-name"), user_package), func_n1(struct_type_name));
   reg_fun(intern(lit("method"), user_package), func_n2v(method_args));
   reg_fun(intern(lit("super-method"), user_package), func_n2(super_method));
   reg_fun(intern(lit("uslot"), user_package), func_n1(uslot));
@@ -1334,6 +1335,12 @@ val struct_type(val strct)
   return si->type->self;
 }
 
+val struct_type_name(val stype)
+{
+  struct struct_type *st = stype_handle(&stype, lit("struct-type-name"));
+  return st->name;
+}
+
 static val method_fun(val env, varg args)
 {
   cons_bind (fun, strct, env);
diff --git a/struct.h b/struct.h
index 481ca679..09bf6767 100644
--- a/struct.h
+++ b/struct.h
@@ -65,6 +65,7 @@ val static_slot_p(val type, val sym);
 val slots(val stype);
 val structp(val obj);
 val struct_type(val strct);
+val struct_type_name(val stype);
 val method(val strct, val slotsym);
 val method_args(val strct, val slotsym, struct args *);
 val super_method(val strct, val slotsym);
diff --git a/txr.1 b/txr.1
index bec5e75b..30717b5e 100644
--- a/txr.1
+++ b/txr.1
@@ -24994,6 +24994,20 @@ A structure type is an object of type
 returned by
 .codn find-struct-type .
 
+.coNP Function @ struct-type-name
+.synb
+.mets (struct-type-name << type )
+.syne
+.desc
+The
+.code struct-type-name
+function returns the symbol which serves as the name of
+.metn type ,
+which must be either a struct type object (such as the return value of
+a successful lookup via
+.codn find-struct-type ),
+or else a struct type name.
+
 .coNP Function @ super
 .synb
 .mets (super << type )