From c6cc120ad042fa234da17cf929c6fdfae1000a5b Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 9 Jul 2021 08:07:02 -0700
Subject: struct: rework stype_handle change.

The change which allows stype_handle to recognize struct
instances, and obtain their type, has some possibly unwanted
ramifications, since the function is widely used.
Let's refactor things so that, for now, only the
struct_type_name function takes advantage of this flexibility.

* struct.c (stype_handle_impl): New static function, copy of
stype_handle, but taking an obj_ok Boolean argument to
indicate whether an object instance is an acceptable argument,
whose type should be fetched.
(stype_handle): Now a wrapper around stype_handle_impl passing
nil for the obj_ok argument.
(stype_handle_obj): New static function. Passes t for the
ok_obj argument of stype_handle_impl.
(struct_type_name): Call stype_handle_obj instead of
stype_handle.
(super): Take advantage of stype_handle_obj to reduce code.

* txr.1: Update documentation of struct-type-name, and improve
that of super.
---
 struct.c | 26 ++++++++++++++------------
 txr.1    | 37 ++++++++++++++++++++-----------------
 2 files changed, 34 insertions(+), 29 deletions(-)

diff --git a/struct.c b/struct.c
index 61916ddb..aa6b86d1 100644
--- a/struct.c
+++ b/struct.c
@@ -274,7 +274,7 @@ static struct struct_inst *struct_handle(val obj, val ctx)
             ctx, obj, nao);
 }
 
-static struct struct_type *stype_handle(val *pobj, val ctx)
+static struct struct_type *stype_handle_impl(val *pobj, val obj_ok, val ctx)
 {
   val obj = *pobj;
 
@@ -291,7 +291,7 @@ static struct struct_type *stype_handle(val *pobj, val ctx)
   case COBJ:
     if (obj->co.cls == struct_type_cls)
       return coerce(struct struct_type *, obj->co.handle);
-    if (obj->co.cls == struct_cls)
+    if (obj_ok && obj->co.cls == struct_cls)
       return struct_handle(obj, ctx)->type;
     /* fallthrough */
   default:
@@ -300,6 +300,16 @@ static struct struct_type *stype_handle(val *pobj, val ctx)
   }
 }
 
+static struct struct_type *stype_handle(val *pobj, val ctx)
+{
+  return stype_handle_impl(pobj, nil, ctx);
+}
+
+static struct struct_type *stype_handle_obj(val *pobj, val ctx)
+{
+  return stype_handle_impl(pobj, t, ctx);
+}
+
 static void static_slot_home_fixup(struct struct_type *st)
 {
   cnum i;
@@ -635,15 +645,7 @@ val super(val type, val idx)
               self, idx, nao);
 
   {
-    struct struct_type *st;
-
-    if (structp(type)) {
-      struct struct_inst *si = coerce(struct struct_inst *, type->co.handle);
-      st = si->type;
-    } else {
-      st = stype_handle(&type, self);
-    }
-
+    struct struct_type *st = stype_handle_obj(&type, self);
     return if2(ix < st->nsupers, st->sus[ix]->self);
   }
 }
@@ -1613,7 +1615,7 @@ val struct_type(val strct)
 
 val struct_type_name(val stype)
 {
-  struct struct_type *st = stype_handle(&stype, lit("struct-type-name"));
+  struct struct_type *st = stype_handle_obj(&stype, lit("struct-type-name"));
   return st->name;
 }
 
diff --git a/txr.1 b/txr.1
index 9d5ae2b1..c36be80c 100644
--- a/txr.1
+++ b/txr.1
@@ -28993,39 +28993,42 @@ returned by
 
 .coNP Function @ struct-type-name
 .synb
-.mets (struct-type-name << type )
+.mets (struct-type-name << type-or-struct )
 .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
+function determines a structure type from the
+.meta type-or-struct
+and returns that structure type's symbolic name.
+
+The
+.meta type-or-struct
+argument 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.
+a symbol which names a struct type,
+or else a struct instance.
 
 .coNP Function @ super
 .synb
-.mets (super << type )
+.mets (super >> [ type-or-struct ])
 .syne
 .desc
 The
 .code super
-function returns the struct type object which is the
-supertype of
-.metn type ,
-or returns
+function determines a structure type from the
+.meta type-or-struct
+and returns the struct type object which is
+the supertype of that type, or else
 .code nil
-if
-.meta type
-has no supertype.
+if that type has no supertype.
 
 The
-.meta type
-argument must be either a struct type object, a
-a symbol which names a struct type (which is resolved to that type),
-or else a structure instance (which is resolved to its structure type).
+.meta type-or-struct
+argument must be either a struct type object,
+a symbol which names a struct type,
+or else a struct instance.
 
 .coNP Function @ make-struct
 .synb
-- 
cgit v1.2.3