Adding defmeth macro and static-slot-ensure.

* share/txr/stdlib/struct.tl (defmeth): New macro.

* struct.c (struct struct_type): New member, dvtypes.
(struct_init): Register static-slot-ensure
intrinsic.
(make_struct_type): Initialize dvtypes of newly instantiated
struct_type struct. If a super is specified, add new type
to the super's dvtypes.
(struct_type_mark): Mark st->dvtypes.
(static_slot_ensure): New function.

* struct.h (static_slot_ensure): Declared.

* txr.1: Documented defmeth and static-slot-ensure.

4 files changed, 135 insertions, 0 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index 7213d9eb..34e9bb07 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -193,3 +193,10 @@
 
 (defmacro umeth (slot)
   ^(umethod ',slot))
+
+(defmacro defmeth (type-sym name arglist . body)
+  ^(progn
+     (static-slot-ensure (find-struct-type ',type-sym) ',name
+                         (lambda ,arglist
+                         (block ,name ,*body)))
+     ',name))
diff --git a/struct.c b/struct.c
index 7b8c2f72..68fc9051 100644
--- a/struct.c
+++ b/struct.c
@@ -62,6 +62,7 @@ struct struct_type {
   val stinitfun;
   val initfun;
   val boactor;
+  val dvtypes;
   val *stslot;
 };
 
@@ -119,6 +120,8 @@ void struct_init(void)
   reg_fun(intern(lit("static-slot"), user_package), func_n2(static_slot));
   reg_fun(intern(lit("static-slot-set"), user_package),
           func_n3(static_slot_set));
+  reg_fun(intern(lit("static-slot-ensure"), user_package),
+          func_n4o(static_slot_ensure, 3));
   reg_fun(intern(lit("call-super-method"), user_package),
           func_n2v(call_super_method));
   reg_fun(intern(lit("call-super-fun"), user_package),
@@ -211,6 +214,7 @@ val make_struct_type(val name, val super,
     st->stinitfun = static_initfun;
     st->initfun = initfun;
     st->boactor = boactor;
+    st->dvtypes = nil;
 
     gc_finalize(stype, struct_type_finalize_f, nil);
 
@@ -241,6 +245,9 @@ val make_struct_type(val name, val super,
 
     sethash(struct_type_hash, name, stype);
 
+    if (super)
+      mpush(stype, mkloc(su->dvtypes, super));
+
     call_stinitfun_chain(st, stype);
 
     return stype;
@@ -305,6 +312,7 @@ static void struct_type_mark(val obj)
   gc_mark(st->stinitfun);
   gc_mark(st->initfun);
   gc_mark(st->boactor);
+  gc_mark(st->dvtypes);
 
   for (stsl = 0; stsl < st->nstslots; stsl++)
     gc_mark(st->stslot[stsl]);
@@ -657,6 +665,44 @@ val static_slot_set(val stype, val sym, val newval)
   no_such_slot(lit("static-slot-set"), stype, sym);
 }
 
+val static_slot_ensure(val stype, val sym, val newval, val no_error_p)
+{
+  val self = lit("static-slot-ensure");
+  struct struct_type *st = coerce(struct struct_type *,
+                                  cobj_handle(stype, struct_type_s));
+
+  if (!bindable(sym))
+    uw_throwf(error_s, lit("~a: ~s isn't a valid slot name"),
+              self, sym, nao);
+
+  no_error_p = default_bool_arg(no_error_p);
+
+  {
+    loc ptr = lookup_static_slot(stype, st, sym);
+    if (!nullocp(ptr))
+      return set(ptr, newval);
+  }
+
+  if (!no_error_p && memq(sym, st->slots))
+    uw_throwf(error_s, lit("~a: ~s is an instance slot of ~s"),
+              self, sym, stype, nao);
+
+  st->stslot = coerce(val *, chk_realloc(coerce(mem_t *, st->stslot),
+                                         sizeof *st->stslot * (st->nstslots + 1)));
+  st->stslot[st->nstslots] = newval;
+  set(mkloc(st->slots, stype), append2(st->slots, cons(sym, nil)));
+  sethash(slot_hash, cons(sym, num_fast(st->id)),
+          num(st->nstslots++ + STATIC_SLOT_BASE));
+
+  {
+    val iter;
+    for (iter = st->dvtypes; iter; iter = cdr(iter))
+      static_slot_ensure(car(iter), sym, newval, t);
+  }
+
+  return newval;
+}
+
 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 52a62fa8..88f5a1c6 100644
--- a/struct.h
+++ b/struct.h
@@ -40,6 +40,7 @@ val slot(val strct, val sym);
 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 slotp(val type, val sym);
 val static_slot_p(val type, val sym);
 val structp(val obj);
diff --git a/txr.1 b/txr.1
index b662380c..1072bb04 100644
--- a/txr.1
+++ b/txr.1
@@ -18246,6 +18246,40 @@ syntax.
   (new (point 1) x 5 y 5) -> #S(point x 1 y 5)
 .cble
 
+.coNP Macro @ defmeth
+.synb
+.mets (defmeth < type-name < name <> param-list << body-form *)
+.syne
+.desc
+The
+.code defmeth
+macro installs a function into the static slot named by the symbol
+.meta name
+in the struct type indicated by
+.metn type-name .
+
+If the structure type doesn't already have such a static slot, it is
+first added, as if by the
+.code static-slot-ensure
+function, subject to the same checks.
+
+If the function has at least one argument, it can be used as a method. In that
+situation, the leftmost argument passes the structure instance on which the
+method is being invoked.
+
+The function takes the arguments specified
+by the
+.meta param-list
+symbols, and its body consists of the
+.metn body-form -s.
+
+The
+.metn body-form -s
+are placed into a
+.code block
+named
+.codn name .
+
 .coNP Macro @ new
 .synb
 .mets (new >> { name | >> ( name << arg *)} >> { slot << init-form }*)
@@ -19108,6 +19142,53 @@ argument must be a structure type, and
 .meta name
 must be a static slot of this type.
 
+.coNP Function @ static-slot-ensure
+.synb
+.mets (static-slot-ensure < type < name < new-value <> [ no-error-p ])
+.syne
+.desc
+The
+.code static-slot-ensure
+function is similar to
+.codn static-slot-set .
+
+It
+.meta new-value
+into the static slot named by symbol
+.meta name
+of the structure type
+.metn type ,
+if there already exists such a static slot.
+
+If the slot does not exist, it is first added to
+the struct type, provided that
+.meta name
+is a bindable symbol. Moreover,
+the struct type must not already have
+an instance slot by that name,
+unless the
+.meta no-error-p
+parameter is specified and true.
+If the
+.meta no-error-p
+parameter is true, then the function does
+not throw an error and does not create a
+static slot.
+
+The function returns
+.metn new-value .
+
+Note: if structure types already exist which are derived from
+.metn type ,
+.code static-slot-ensure
+is recursively invoked on each derived type to ensure that these
+types also have this static slot and it is given the specified value. The
+.meta no-error-p
+parameter is
+.code nil
+in these recursive calls, so that the static slot is only added
+to those structures which do not already have an instance slot.
+
 .coNP Function @ call-super-method
 .synb
 .mets (call-super-method < struct-obj < name << argument *)