structs: improve access to initfun and postinitfun.

In this change, a struct type's initfun and postinitfun
become mutable. This is achieved by modeling them as
the pseudo-static-slots :initfun and :postinitfun.
Effectively these now behave as reserved names which do not
denote static slots but these special functions.

* eval.c (lookup_fun): When (meth type slot) syntax is
encountered, treat the slot names :init and :postinit
specially: retrieve these special functions instead of
accessing static slots.

* share/txr/stdlib/place.tl (sys:get-fun-getter-setter):
Similarly, when handling (meth type slot) syntax, return
the alternative getter/setter functions for the special
functions, not the static slot accessing functions.
Also, getting rid of a useless @1 here in existing code,
since (op foo @1) is equivalent to (op foo).

* share/txr/stdlib/struct.tl (sys:defmeth): Check for
the special names :init and :postinit, handling these
through the appropriate setter functions rather than
static-slot-ensure.

* struct.c (init_k, postinit_k): New keyword symbol variables.
(struct_init): Initialize init_k and postinit_k. Register
intrinsics struct-get-initfun, struct-set-initfun,
struct-get-postinitfun and struct-set-postinitfun.
* (struct_get_initfun, struct_set_initfun,
struct_get_postinitfun, struct_set_postinitfun): New
functions.
(method_name): For each struct type visited, check
whether the function is the initfun or postinitfun
and return the appropriate meth syntax if so.

* struct.h (init_k, postinit_k, struct_get_initfun,
struct_set_initfun, struct_get_postinitfun,
struct_set_postinitfun): Declared.

* txr.1: Documented. Updated description of method-name,
defmeth, and documented new functions.

1 files changed, 39 insertions, 0 deletions

diff --git a/struct.c b/struct.c
index c1098c3d..4c5dd2d0 100644
--- a/struct.c
+++ b/struct.c
@@ -90,6 +90,7 @@ struct struct_inst {
 };
 
 val struct_type_s, meth_s, print_s, make_struct_lit_s;
+val init_k, postinit_k;
 val slot_s, static_slot_s;
 
 static cnum struct_id_counter;
@@ -117,6 +118,8 @@ void struct_init(void)
   meth_s = intern(lit("meth"), user_package);
   print_s = intern(lit("print"), user_package);
   make_struct_lit_s = intern(lit("make-struct-lit"), system_package);
+  init_k = intern(lit("init"), keyword_package);
+  postinit_k = intern(lit("postinit"), keyword_package);
   slot_s = intern(lit("slot"), system_package);
   static_slot_s = intern(lit("static-slot"), system_package);
   struct_type_hash = make_hash(nil, nil, nil);
@@ -138,6 +141,10 @@ void struct_init(void)
   reg_fun(intern(lit("find-struct-type"), user_package),
           func_n1(find_struct_type));
   reg_fun(intern(lit("struct-type-p"), user_package), func_n1(struct_type_p));
+  reg_fun(intern(lit("struct-get-initfun"), user_package), func_n1(struct_get_initfun));
+  reg_fun(intern(lit("struct-set-initfun"), user_package), func_n2(struct_set_initfun));
+  reg_fun(intern(lit("struct-get-postinitfun"), user_package), func_n1(struct_get_postinitfun));
+  reg_fun(intern(lit("struct-set-postinitfun"), user_package), func_n2(struct_set_postinitfun));
   reg_fun(intern(lit("super"), user_package), func_n1(super));
   reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct));
   reg_fun(intern(lit("struct-from-plist"), user_package), func_n1v(struct_from_plist));
@@ -391,6 +398,32 @@ val struct_type_p(val obj)
   return tnil(typeof(obj) == struct_type_s);
 }
 
+val struct_get_initfun(val type)
+{
+  struct struct_type *st = stype_handle(&type, lit("struct-get-initfun"));
+  return st->initfun;
+}
+
+val struct_set_initfun(val type, val fun)
+{
+  struct struct_type *st = stype_handle(&type, lit("struct-set-initfun"));
+  st->initfun = fun;
+  return fun;
+}
+
+val struct_get_postinitfun(val type)
+{
+  struct struct_type *st = stype_handle(&type, lit("struct-get-postinitfun"));
+  return st->postinitfun;
+}
+
+val struct_set_postinitfun(val type, val fun)
+{
+  struct struct_type *st = stype_handle(&type, lit("struct-set-postinitfun"));
+  st->postinitfun = fun;
+  return fun;
+}
+
 val super(val type)
 {
   if (structp(type)) {
@@ -1515,6 +1548,12 @@ val method_name(val fun)
         return list(meth_s, sym, slot, nao);
       }
     }
+
+    if (st->initfun == fun)
+      return list(meth_s, sym, init_k, nao);
+
+    if (st->postinitfun == fun)
+      return list(meth_s, sym, postinit_k, nao);
   }
 
   return nil;