* hash.c (hash_equal_op, hash_hash_op): New static functions.

(hash_ops): New functions registered in table of operations.

* txr.1: Documentation for equal function updated to explain
how two hashes are equal.

3 files changed, 139 insertions, 14 deletions

diff --git a/ChangeLog b/ChangeLog
index 53386f4f..b04577bc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2014-02-12  Kaz Kylheku  <kaz@kylheku.com>
 
+	* hash.c (hash_equal_op, hash_hash_op): New static functions.
+	(hash_ops): New functions registered in table of operations.
+
+	* txr.1: Documentation for equal function updated to explain
+	how two hashes are equal.
+
+2014-02-12  Kaz Kylheku  <kaz@kylheku.com>
+
 	Undoing bogus optimization, which can only work when objects
 	are treated as immutable.
 
diff --git a/hash.c b/hash.c
index 00b3896c..cd91ad5e 100644
--- a/hash.c
+++ b/hash.c
@@ -219,6 +219,110 @@ static val print_key_val(val out, val key, val value)
   return nil;
 }
 
+static val hash_equal_op(val left, val right)
+{
+  uses_or2;
+  struct hash *l = (struct hash *) left->co.handle;
+  struct hash *r = (struct hash *) right->co.handle;
+  val liter, riter, lcell, rcell;
+  val free_conses = nil;
+  val pending = nil;
+
+  if (l->hash_fun != r->hash_fun)
+    return nil;
+
+  if (l->count != r->count)
+    return nil;
+
+  if (!equal(l->userdata, r->userdata))
+    return nil;
+
+  if (l->count == 0)
+    return t;
+
+  liter = hash_begin(left);
+  riter = hash_begin(right);
+
+  while ((lcell = hash_next(liter)) && ((rcell = hash_next(riter)))) {
+    val ncons = or2(pop(&free_conses), cons(nil, nil));
+    val found;
+
+    /*
+     * Try to find a cell matching the left cell on the pending list by key.
+     * If it is found, and the associated datum is equal, then remove it from
+     * the list.  If it is found and the data is not equal, then we have found
+     * a difference between the hash tables, and conclude they are different.
+     * If there is no match, then we insert the cell into the pending list. 
+     */
+    found = l->assoc_fun(car(lcell), pending);
+
+    if (found && !equal(cdr(found), cdr(lcell))) {
+      return nil;
+    } else if (found) {
+      val loc = memq(found, pending);
+      pending = nappend2(ldiff(pending, loc), cdr(loc));
+      set(*cdr_l(loc), free_conses);
+      free_conses = loc;
+    } else {
+      ncons = or2(pop(&free_conses), cons(nil, nil));
+      set(*car_l(ncons), lcell);
+      set(*cdr_l(ncons), pending);
+      pending = ncons;
+    }
+
+    /*
+     * The logic is mirrored for the right cell.
+     */
+    found = l->assoc_fun(car(rcell), pending);
+
+    if (found && !equal(cdr(found), cdr(rcell))) {
+      return nil;
+    } else if (found) {
+      val loc = memq(found, pending);
+      pending = nappend2(ldiff(pending, loc), cdr(loc));
+      set(*cdr_l(loc), free_conses);
+      free_conses = loc;
+    } else {
+      ncons = or2(pop(&free_conses), cons(nil, nil));
+      set(*car_l(ncons), rcell);
+      set(*cdr_l(ncons), pending);
+      pending = ncons;
+    }
+  }
+
+  /*
+   * The hashes are equal if and only if the pending list
+   * balances down to zero.
+   */
+  return eq(pending, nil);
+}
+
+static cnum hash_hash_op(val obj)
+{
+  cnum out = 0;
+  struct hash *h = (struct hash *) obj->co.handle;
+  val iter, cell;
+
+  switch (sizeof (mem_t *)) {
+  case 4:
+    out += ((cnum) h->hash_fun) >> 4;
+  case 8: default:
+    out += ((cnum) h->hash_fun) >> 5;
+  }
+
+  out += equal_hash(h->userdata);
+  out &= NUM_MAX;
+
+  iter = hash_begin(obj);
+
+  while ((cell = hash_next(iter)) != nil) {
+    out += equal_hash(cell);
+    out &= NUM_MAX;
+  }
+
+  return out;
+}
+
 static void hash_print_op(val hash, val out)
 {
   struct hash *h = (struct hash *) hash->co.handle;
@@ -302,11 +406,11 @@ static void hash_mark(val hash)
 }
 
 static struct cobj_ops hash_ops = {
-  cobj_equal_op,
+  hash_equal_op,
   hash_print_op,
   cobj_destroy_free_op,
   hash_mark,
-  cobj_hash_op
+  hash_hash_op,
 };
 
 static void hash_grow(struct hash *h)
diff --git a/txr.1 b/txr.1
index 976b4c34..795170c9 100644
--- a/txr.1
+++ b/txr.1
@@ -6347,18 +6347,31 @@ the same numeric value, eql returns t, even if they are different objects.
 For all other objects, eql behaves like eq.
 
 The equal function is less strict than eql. In general, it recurses into some
-kinds of aggregate objects to perform a structural equivalence.  If <left-obj>
-and <right-obj> are eql then they are also equal.  If the two objects are both
-cons cells, then they are equal if their "car" fields are equal and their "cdr"
-fields are equal.  If two objects are vectors, they are equal if they have the
-same length, and their corresponding elements are equal.  If two objects are
-strings, they are equal if they are textually identical.  If two objects are
-functions, they are equal if they have equal environments, and if they have
-equal functions. Two compiled functions are the same if they are the same
-function. Two interpreted functions are equal if their list structure is equal.
-
-For some aggregate objects, there is no special semantics.  Two hashes,
-symbols, packages, or streams are equal if they are the same hash.
+kinds of aggregate objects to perform a structural equivalence.  
+
+If <left-obj> and <right-obj> are eql then they are also equal.  
+
+If the two objects are both cons cells, then they are equal if their "car"
+fields are equal and their "cdr" fields are equal.  
+
+If two objects are vectors, they are equal if they have the same length, and
+their corresponding elements are equal. 
+
+If two objects are strings, they are equal if they are textually identical.  
+
+If two objects are functions, they are equal if they have equal environments,
+and if they have equal functions.  Two compiled functions are the same if they
+are the same function. Two interpreted functions are equal if their list
+structure is equal.
+
+Two hashes are equal if they use the same equality (both are equal-based,
+or both are the default eql-based), if their user-data elements are equal, if
+their sets of keys are identical, and if the data items associated with
+corresponding keys from each respective hash are equal objects.
+
+For some aggregate objects, there is no special semantics.  Two arguments
+which are symbols, packages, or streams are equal if and only if they
+are the same object.
 
 Certain object types have a custom equal function.