oop: special methods to handle missing slots.

* struct.h (slotset_s, static_slot_s, static_slot_set_s): New
symbol variables declared.
(enum special_slot): New enum symbols: slot_m, slotset_m,
static_slot_m, static_slot_set_m.

* struct.c (slotset_s, static_slot_s, static_slot_set_s): New
symbol variables.
(special_sym): Associate new symbols with new enums.
(struct_init): Intern slotset, static-slot and static-slot-set
symbols, initializing the variables. Change the registrations
of the same-named functions to use the variables.
(slot, maybe_slot, slotset, static_slot, static_slot_set):
In the no-such-slot case, check for the special method and
call it.

* tests/012/oop.tl: New tests.

* txr.1: Documented.

4 files changed, 158 insertions, 8 deletions

diff --git a/struct.c b/struct.c
index a449e9d7..a51bed80 100644
--- a/struct.c
+++ b/struct.c
@@ -105,7 +105,7 @@ struct struct_inst {
 
 val struct_type_s, meth_s, print_s, make_struct_lit_s;
 val init_k, postinit_k;
-val slot_s, derived_s;
+val slot_s, slotset_s, static_slot_s, static_slot_set_s, derived_s;
 
 val copy_s, nullify_s, from_list_s, lambda_set_s;
 
@@ -115,7 +115,7 @@ static val *special_sym[num_special_slots] = {
   &equal_s, &copy_s, &nullify_s, &from_list_s, &lambda_s, &lambda_set_s,
   &length_s, &length_lt_s, &car_s, &cdr_s, &rplaca_s, &rplacd_s,
   &iter_begin_s, &iter_more_s, &iter_item_s, &iter_step_s, &iter_reset_s,
-  &plus_s
+  &plus_s, &slot_s, &slotset_s, &static_slot_s, &static_slot_set_s
 };
 
 static struct cobj_class *struct_type_cls;
@@ -148,6 +148,9 @@ void struct_init(void)
   init_k = intern(lit("init"), keyword_package);
   postinit_k = intern(lit("postinit"), keyword_package);
   slot_s = intern(lit("slot"), user_package);
+  slotset_s = intern(lit("slotset"), user_package);
+  static_slot_s = intern(lit("static-slot"), user_package);
+  static_slot_set_s = intern(lit("static-slot-set"), user_package);
   derived_s = intern(lit("derived"), user_package);
   copy_s = intern(lit("copy"), user_package);
   nullify_s = intern(lit("nullify"), user_package);
@@ -193,10 +196,9 @@ void struct_init(void)
   reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1));
   reg_fun(intern(lit("reset-struct"), user_package), func_n1(reset_struct));
   reg_fun(slot_s, func_n2(slot));
-  reg_fun(intern(lit("slotset"), user_package), func_n3(slotset));
-  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(slotset_s, func_n3(slotset));
+  reg_fun(static_slot_s, func_n2(static_slot));
+  reg_fun(static_slot_set_s, func_n3(static_slot_set));
   reg_fun(intern(lit("test-dirty"), user_package), func_n1(test_dirty));
   reg_fun(intern(lit("test-clear-dirty"), user_package), func_n1(test_clear_dirty));
   reg_fun(intern(lit("clear-dirty"), user_package), func_n1(clear_dirty));
@@ -1275,6 +1277,13 @@ val slot(val strct, val sym)
       return deref(ptr);
   }
 
+  {
+    val slot_meth = get_special_slot(strct, slot_m);
+
+    if (slot_meth)
+      return funcall2(slot_meth, strct, sym);
+  }
+
   no_such_slot(self, si->type->self, sym);
 }
 
@@ -1289,6 +1298,13 @@ val maybe_slot(val strct, val sym)
       return deref(ptr);
   }
 
+  {
+    val slot_meth = get_special_slot(strct, slot_m);
+
+    if (slot_meth)
+      return funcall2(slot_meth, strct, sym);
+  }
+
   return nil;
 }
 
@@ -1311,6 +1327,13 @@ val slotset(val strct, val sym, val newval)
     }
   }
 
+  {
+    val slotset_meth = get_special_slot(strct, slotset_m);
+
+    if (slotset_meth)
+      return funcall3(slotset_meth, strct, sym, newval);
+  }
+
   no_such_slot(self, si->type->self, sym);
 }
 
@@ -1325,6 +1348,13 @@ val static_slot(val stype, val sym)
       return deref(ptr);
   }
 
+  {
+    val static_slot_meth = get_special_slot_by_type(st->self, static_slot_m);
+
+    if (static_slot_meth)
+      return funcall2(static_slot_meth, st->self, sym);
+  }
+
   no_such_static_slot(self, stype, sym);
 }
 
@@ -1341,6 +1371,14 @@ val static_slot_set(val stype, val sym, val newval)
     }
   }
 
+  {
+    val static_slot_set_meth = get_special_slot_by_type(st->self,
+                                                        static_slot_set_m);
+
+    if (static_slot_set_meth)
+      return funcall3(static_slot_set_meth, st->self, sym, newval);
+  }
+
   no_such_static_slot(self, stype, sym);
 }
 
diff --git a/struct.h b/struct.h
index 0b284ac0..e3d75221 100644
--- a/struct.h
+++ b/struct.h
@@ -28,7 +28,7 @@
 
 extern val struct_type_s, meth_s, print_s, make_struct_lit_s;
 extern val init_k, postinit_k;
-extern val slot_s, derived_s;
+extern val slot_s, slotset_s, static_slot_s, static_slot_set_s, derived_s;
 extern val lambda_set_s;
 extern val iter_begin_s, iter_more_s, iter_item_s, iter_step_s, iter_reset_s;
 
@@ -39,7 +39,7 @@ enum special_slot {
   equal_m, copy_m, nullify_m, from_list_m, lambda_m, lambda_set_m,
   length_m, length_lt_m, car_m, cdr_m, rplaca_m, rplacd_m,
   iter_begin_m, iter_more_m, iter_item_m, iter_step_m, iter_reset_m,
-  plus_m,
+  plus_m, slot_m, slotset_m, static_slot_m, static_slot_set_m,
   num_special_slots
 };
 
diff --git a/tests/012/oop.tl b/tests/012/oop.tl
index 8bf8b4b4..7633b645 100644
--- a/tests/012/oop.tl
+++ b/tests/012/oop.tl
@@ -159,3 +159,39 @@
   (new node left (succ me.left) right (succ me.right)))
 
 (test (copy (new node left 1 right 2)) #S(node left 2 right 3))
+
+(defstruct cust-slots ()
+  a
+  (:method slot (me slot) ^(slot ,slot))
+  (:method slotset (me slot new) ^(slotset ,slot ,new))
+  (:function static-slot (type slot) ^(static-slot ,slot))
+  (:function static-slot-set (type slot new) ^(static-slot-set ,slot ,new)))
+
+(defstruct no-cust-slots ()
+  a)
+
+(defstruct get-type ()
+  (:function static-slot (type slot) type)
+  (:function static-slot-set (type slot new) type))
+
+(let ((o (new cust-slots)))
+  (mtest
+    o.a nil
+    o.b (slot b)
+    (set o.b 3) (slotset b 3)
+    (static-slot 'cust-slots 'b) (static-slot b)
+    (static-slot-set 'cust-slots 'b 3) (static-slot-set b 3)))
+
+(let ((o (new no-cust-slots)))
+  (mtest
+    o.a nil
+    o.b :error
+    (set o.b 3) :error
+    (static-slot 'no-cust-slots 'b) :error
+    (static-slot-set 'no-cust-slots 'b 3) :error))
+
+(mvtest
+  (static-slot 'get-type 'b) (find-struct-type 'get-type)
+  (static-slot (find-struct-type 'get-type) 'b) (find-struct-type 'get-type)
+  (static-slot-set 'get-type 'b 3) (find-struct-type 'get-type)
+  (static-slot-set (find-struct-type 'get-type) 'b 3) (find-struct-type 'get-type))
diff --git a/txr.1 b/txr.1
index 8f3c9299..d42bd928 100644
--- a/txr.1
+++ b/txr.1
@@ -33631,6 +33631,82 @@ any output output pertaining to
 .metn object 's
 representation.
 
+.coNP Methods @ slot and @ slot-set
+.synb
+.mets << object .(slot << slot-name )
+.mets << object .(slot-set < slot-name << new-value )
+.syne
+.desc
+Defining these methods allows a struct type to handle the situation
+when a nonexistent slot is accessed.
+
+The
+.code slot
+method, if it exists, is invoked if a slot named
+.meta slot-name
+is accessed by the
+.code slot
+function, or equivalent syntax, and that slot does not exist.
+The value returned by the method is taken to be the nonexistent
+slot's value.
+
+When a value is stored in a slot named
+.meta slot-name
+by the
+.code slotset
+function, or equivalent syntax, and the slot does not exist, then the
+.code slotset
+method is invoked, if it exists. 
+It is recommended that the
+.code slotset
+function return
+.metn new-value ,
+since the value returned propagates out of the
+.code slotset
+function, which in all other cases returns
+.metn new-value ,
+which is important to the implementation of syntactic places
+that designate slots.
+
+.coNP Functions @ static-slot and @ static-slot-set
+.synb
+.mets << object .[static-slot < type << slot-name )
+.mets << object .[static-slot-set < type < slot-name << new-value )
+.syne
+.desc
+The
+.code static-slot
+and
+.code static-slot-set
+functions are analogous to the
+.code slot
+and
+.codn slotset ,
+methods. These functions, if they exist, are only invoked
+when a static slot lookup fails.  Static slot lookups occur through the
+.code static-slot
+and
+.code static-slot-set
+functions, which can be used directly and are used in certain
+situations. For instance when
+.code "(meth ...)"
+syntax is looked up with
+.codn symbol-function ,
+static slot lookup is used. It is recommended that for simulating the
+existence of structure functions and methods, these methods be used.
+
+The
+.metn type ,
+argument is an object of type
+.code struct-type
+giving the structure type on which the static slot lookup is taking
+place.
+
+It is recommended that the
+.code static-slot-set
+function return
+.metn new-value .
+
 .coNP Method @ lambda
 .synb
 .mets << object .(lambda << arg *)