New equality substitution.

If the equal method is defined for structs, its return
value is used in their place for hashing and comparison.

* eval.h (eq_s, eql_s, equal_s): Declared.

* hash.c (equal_hash): If a COBJ defines an equalsub
function, we call it. If it returns non-nil, we
take the object in its place and recurse.

* lib.c (equal): Refactored to support equality substitution.
(less): Support equality substitution.

* lib.h (cobj_ops): New function pointer member, equalsub.
Only struct instances define this, currently.
(cobj_ops_init): Add null entry to initializer for equalsub.
(cobj_ops_init_ex): New initialiation macro for
situations when the equalsub member must be provided.

* struct.c (struct struct_type): new member eqmslot.
(make_struct_type): Initialize emslot to zero.
(static_slot_set, static_slot_ensure): If eqmslot is -1,
indicating positive knowledge that there is no equal method
static slot, we must invalidate that with a zero: it is no
longer known whether there is or isn't such a slot.
(get_equal_method, struct_inst_equalsub): New static functions.
(struct_inst_ops): Initialize the equalsub member using
new cobj_ops_init_ex macro.

* txr.1: Document equality substitution.

1 files changed, 45 insertions, 5 deletions

diff --git a/struct.c b/struct.c
index d4521314..5ccd68b7 100644
--- a/struct.c
+++ b/struct.c
@@ -55,6 +55,7 @@ struct struct_type {
   cnum id;
   cnum nslots;
   cnum nstslots;
+  cnum eqmslot;
   val super;
   struct struct_type *super_handle;
   val slots;
@@ -232,7 +233,7 @@ val make_struct_type(val name, val super,
 
     st->name = name;
     st->id = c_num(id);
-    st->nslots = st->nstslots = 0;
+    st->nslots = st->nstslots = st->eqmslot = 0;
     st->slots = all_slots;
     st->super = super;
     st->stslot = 0;
@@ -746,8 +747,11 @@ val static_slot_set(val stype, val sym, val newval)
 
   if (symbolp(sym)) {
     loc ptr = lookup_static_slot(stype, st, sym);
-    if (!nullocp(ptr))
+    if (!nullocp(ptr)) {
+      if (st->eqmslot == -1)
+        st->eqmslot = 0;
       return set(ptr, newval);
+    }
   }
 
   no_such_slot(self, stype, sym);
@@ -764,6 +768,9 @@ val static_slot_ensure(val stype, val sym, val newval, val no_error_p)
 
   no_error_p = default_bool_arg(no_error_p);
 
+  if (st->eqmslot == -1)
+    st->eqmslot = 0;
+
   {
     loc ptr = lookup_static_slot(stype, st, sym);
     if (!nullocp(ptr))
@@ -1004,11 +1011,44 @@ static cnum struct_inst_hash(val obj)
   return out;
 }
 
+static val get_equal_method(val stype, struct struct_type *st)
+{
+  if (st->eqmslot == -1) {
+    return nil;
+  } else if (st->eqmslot) {
+    return st->stslot[st->eqmslot];
+  } else {
+    loc ptr = lookup_static_slot(stype, st, equal_s);
+    if (!nullocp(ptr)) {
+      st->eqmslot = valptr(ptr) - st->stslot;
+      return deref(ptr);
+    }
+    st->eqmslot = -1;
+    return nil;
+  }
+}
+
+static val struct_inst_equalsub(val obj)
+{
+  struct struct_inst *si = coerce(struct struct_inst *, obj->co.handle);
+  struct struct_type *st = coerce(struct struct_type *, si->type->co.handle);
+  val equal_method = get_equal_method(obj, st);
+  if (equal_method) {
+    val sub = funcall1(equal_method, obj);
+    if (nilp(sub)) {
+      uw_throwf(error_s, lit("equal method on type ~s returned nil"),
+                si->type, nao);
+    }
+    return sub;
+  }
+  return nil;
+}
+
 static_def(struct cobj_ops struct_type_ops =
            cobj_ops_init(eq, struct_type_print, struct_type_destroy,
                          struct_type_mark, cobj_hash_op))
 
 static_def(struct cobj_ops struct_inst_ops =
-           cobj_ops_init(struct_inst_equal, struct_inst_print,
-                         cobj_destroy_free_op, struct_inst_mark,
-                         struct_inst_hash))
+           cobj_ops_init_ex(struct_inst_equal, struct_inst_print,
+                            cobj_destroy_free_op, struct_inst_mark,
+                            struct_inst_hash, struct_inst_equalsub))