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.

6 files changed, 202 insertions, 7 deletions

diff --git a/eval.c b/eval.c
index 0a6940eb..679b12aa 100644
--- a/eval.c
+++ b/eval.c
@@ -486,8 +486,14 @@ val lookup_fun(val env, val sym)
         val type = or2(find_struct_type(strct),
                        if2(lisplib_try_load(strct),
                          find_struct_type(strct)));
-        return if2(and2(type, static_slot_p(type, slot)),
-                   cons(sym, static_slot(type, slot)));
+        if (slot == init_k) {
+          return cons(sym, struct_get_initfun(type));
+        } else if (slot == postinit_k) {
+          return cons(sym, struct_get_postinitfun(type));
+        } else {
+          return if2(and2(type, static_slot_p(type, slot)),
+                     cons(sym, static_slot(type, slot)));
+        }
       } else if (car(sym) == macro_s) {
         return lookup_mac(nil, cadr(sym));
       } else if (car(sym) == lambda_s) {
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index 2e15118b..90251726 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -803,8 +803,13 @@
   (tree-case sym
     ((type struct slot)
       (if (eq type 'meth)
-        (cons (op static-slot struct slot)
-              (op static-slot-set struct slot @1))
+        (caseql slot
+          (:init (cons (op struct-get-initfun struct)
+                       (op struct-set-initfun struct)))
+          (:postinit (cons (op struct-get-postinitfun struct)
+                           (op struct-set-postinitfun struct)))
+          (t (cons (op static-slot struct slot)
+                   (op static-slot-set struct slot))))
         :))
     ((type sym)
       (if (eq type 'macro)
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 8548e03a..68b86c95 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -286,7 +286,10 @@
   ^[(fun umethod) ',slot ,*bound-args])
 
 (defun sys:defmeth (type-sym name fun)
-  (static-slot-ensure type-sym name fun)
+  (caseq name
+    (:init (struct-set-initfun type-sym fun))
+    (:postinit (struct-set-postinitfun type-sym fun))
+    (t (static-slot-ensure type-sym name fun)))
   ^(meth ,type-sym ,name))
 
 (defmacro defmeth (:form form type-sym name arglist . body)
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;
diff --git a/struct.h b/struct.h
index e558745f..cab0799d 100644
--- a/struct.h
+++ b/struct.h
@@ -26,12 +26,17 @@
  */
 
 extern val struct_type_s, meth_s, print_s, make_struct_lit_s;
+extern val init_k, postinit_k;
 extern val slot_s, static_slot_s;
 val make_struct_type(val name, val super,
                      val static_slots, val slots,
                      val static_initfun, val initfun, val boactor,
                      val postinitfun);
 val struct_type_p(val obj);
+val struct_get_initfun(val type);
+val struct_set_initfun(val type, val fun);
+val struct_get_postinitfun(val type);
+val struct_set_postinitfun(val type, val fun);
 val super(val type);
 val make_struct(val type, val plist, struct args *);
 val struct_from_plist(val type, struct args *plist);
diff --git a/txr.1 b/txr.1
index e38d8e53..368952db 100644
--- a/txr.1
+++ b/txr.1
@@ -15912,7 +15912,12 @@ where
 .meta struct
 names a struct type, and
 .meta slot
-a static slot. Names in this format are returned by the
+is either a static slot or one of the keyword symbols
+.code :init
+or
+.code :postinit
+which refer to special functions associated with a structure type.
+Names in this format are returned by the
 .meta func-get-name
 function.  The
 .code symbol-function
@@ -16296,6 +16301,23 @@ is a symbol denoting the struct type and
 is the static slot of the struct type which holds
 .metn func .
 
+A check is also performed whether
+.meta func
+might be equal to one of the two special functions of
+a structure type: its
+.meta initfun
+or
+.metn postinitfun ,
+in which case it is returned as either the
+.cblk
+.meti (meth < type << :init)
+.cble
+or the
+.cblk
+.meti (meth < type << :postinit)
+.cble
+syntax.
+
 If
 .meta func
 is an interpreted function not found under any name,
@@ -22724,7 +22746,13 @@ syntax.
 .mets (defmeth < type-name < name < param-list << body-form *)
 .syne
 .desc
-The
+Unless
+.meta name
+is one of the two symbols
+.code :init
+or
+.codn :postinit ,
+the
 .code defmeth
 macro installs a function into the static slot named by the symbol
 .meta name
@@ -22769,6 +22797,49 @@ from that of
 In particular, the method will be imposed into all subtypes which inherit
 (do not override) the method.
 
+If
+.meta name
+is the keyword symbol
+.codn :init ,
+then instead of operating on a static slot, the macro redefines the
+.meta initfun
+of the given structure type, as if by a call to the function
+.codn struct-set-initfun .
+
+Similarly, if
+.meta name
+is the keyword symbol
+.codn :postinit ,
+then the macro redefines the
+.meta postinitfun
+of the given structure type, as if by a call to the function
+.codn struct-set-postinitfun .
+
+When redefining
+.code :initfun
+the admonishments given in the description of
+.code struct-set-initfun
+apply: if the type has an
+.meta initfun
+generated by the
+.code defstruct
+macro, then that
+.meta initfun
+is what implements all of the slot initializations given in the
+slot specifier syntax. These initializations are lost if the
+.meta initfun
+is overwritten.
+
+The
+.code defmeth
+macro returns a method name: a unit of syntax of the form
+.cblk
+.meti (meth < type-name << name)
+.cble
+which can be used as an argument to the accessor
+.code symbol-function
+and other situations.
+
 .coNP Macros @ new and @ lnew
 .synb
 .mets (new >> { name | >> ( name << arg *)} >> { slot << init-form }*)
@@ -24460,6 +24531,72 @@ can also be written:
     ((meth base fun) obj arg))
 .cble
 
+.coNP Functions @ struct-get-initfun and @ struct-get-postinitfun
+.synb
+.mets (struct-get-initfun << type )
+.mets (struct-get-postinitfun << type )
+.syne
+.desc
+The
+.code struct-get-initfun
+and
+.code struct-get-postinitfun
+functions retrieve, respectively, a structure type's
+.meta initfun
+and
+.meta postinitfun
+functions. These are the functions which are initially configured in the call to
+.code make-struct-type
+via the
+.meta initfun
+and
+.meta postinitfun
+arguments.
+
+Either one may be
+.codn nil ,
+indicating that the type has no
+.meta initfun
+or
+.metn postinitfun .
+
+.coNP Functions @ struct-set-initfun and @ struct-set-postinitfun
+.synb
+.mets (struct-set-initfun < type << function )
+.mets (struct-set-postinitfun < type << function )
+.syne
+.desc
+The
+.code struct-set-initfun
+and
+.code struct-set-postinitfun
+functions overwrite, respectively, a structure type's
+.meta initfun
+and
+.meta postinitfun
+functions. These are the functions which are initially configured in the call to
+.code make-struct-type
+via the
+.meta initfun
+and
+.meta postinitfun
+arguments.
+
+The
+.meta function
+argument must either be
+.code nil
+or else a function which accepts one argument.
+
+Note that
+.meta initfun
+has the responsibility for all instance slot initializations. The
+.code defstruct
+syntax compiles the initializing expressions in the slot specifier syntax
+into statements which are placed into a function, which becomes the
+.meta initfun
+of the struct type.
+
 .coNP Macro @ with-objects
 .synb
 .mets (with-objects >> ({( sym << init-form )}*) << body-form *)