From 36801f7c544ccd3bd6c66f5a6d7acee3ab2d48d7 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Mon, 7 Nov 2011 19:13:30 -0500
Subject: [PATCH] hash-equal?

---
 compiler/kernel-primitives.rkt                 |  1 +
 js-assembler/runtime-src/baselib-hashes.js     |  6 ++++++
 js-assembler/runtime-src/baselib-primitives.js |  6 ++++++
 lang/kernel.rkt                                |  1 +
 tests/more-tests/hashes.expected               | 13 +++++++++++++
 tests/more-tests/hashes.rkt                    | 16 +++++++++++++++-
 6 files changed, 42 insertions(+), 1 deletion(-)

diff --git a/compiler/kernel-primitives.rkt b/compiler/kernel-primitives.rkt
index c2d04a6..4db3761 100644
--- a/compiler/kernel-primitives.rkt
+++ b/compiler/kernel-primitives.rkt
@@ -90,6 +90,7 @@
                                     'prop:exn:srclocs
 
                                     'hash?
+                                    'hash-equal?
                                     'hash-eq?
                                     'hash-eqv?
                                     'hash
diff --git a/js-assembler/runtime-src/baselib-hashes.js b/js-assembler/runtime-src/baselib-hashes.js
index 0e62b41..1cf4269 100644
--- a/js-assembler/runtime-src/baselib-hashes.js
+++ b/js-assembler/runtime-src/baselib-hashes.js
@@ -361,6 +361,10 @@
         return (x instanceof WhalesongHashtable || x instanceof WhalesongImmutableHashtable);
     };
 
+    var isHashEqual = function (x) { 
+        return (x instanceof WhalesongHashtable || x instanceof WhalesongImmutableHashtable) && x.type === 'hash';
+    };
+
     var isHashEqv = function (x) { 
         return (x instanceof WhalesongHashtable || x instanceof WhalesongImmutableHashtable) && x.type === 'hasheqv';
     };
@@ -437,6 +441,8 @@
     exports.makeImmutableEqualHashtable = makeImmutableEqualHashtable;
 
     exports.isHash = isHash;
+
+    exports.isHashEqual = isHashEqual;
     exports.isHashEqv = isHashEqv;
     exports.isHashEq = isHashEq;
 }(window.plt.baselib, Hashtable));
\ No newline at end of file
diff --git a/js-assembler/runtime-src/baselib-primitives.js b/js-assembler/runtime-src/baselib-primitives.js
index ae197e8..620750e 100644
--- a/js-assembler/runtime-src/baselib-primitives.js
+++ b/js-assembler/runtime-src/baselib-primitives.js
@@ -2524,6 +2524,12 @@
         function(M) {
             return baselib.hashes.isHash(checkAny(M, 'hash?', 0));
         });
+    installPrimitiveProcedure(
+        'hash-equal?',
+        1,
+        function(M) {
+            return baselib.hashes.isHashEqual(checkAny(M, 'hash-equal?', 0));
+        });
     installPrimitiveProcedure(
         'hash-eq?',
         1,
diff --git a/lang/kernel.rkt b/lang/kernel.rkt
index 12ea311..828545a 100644
--- a/lang/kernel.rkt
+++ b/lang/kernel.rkt
@@ -150,6 +150,7 @@
 	 with-continuation-mark
 
          hash?
+         hash-equal?
          hash-eq?
          hash-eqv?
          hash
diff --git a/tests/more-tests/hashes.expected b/tests/more-tests/hashes.expected
index 2fd4962..923a3cc 100644
--- a/tests/more-tests/hashes.expected
+++ b/tests/more-tests/hashes.expected
@@ -27,6 +27,9 @@ not-found
 true
 true
 true
+true
+false
+false
 false
 true
 false
@@ -58,3 +61,13 @@ alphabet
 
 1
 2
+
+true
+false
+false
+false
+true
+false
+false
+false
+true
diff --git a/tests/more-tests/hashes.rkt b/tests/more-tests/hashes.rkt
index cfca056..b2935b3 100644
--- a/tests/more-tests/hashes.rkt
+++ b/tests/more-tests/hashes.rkt
@@ -80,6 +80,9 @@
 (hash? (make-immutable-hash))
 (hash? (make-immutable-hasheq))
 (hash? (make-immutable-hasheqv))
+(hash-equal? (make-immutable-hash))
+(hash-equal? (make-immutable-hasheq))
+(hash-equal? (make-immutable-hasheqv))
 (hash-eq? (make-immutable-hash))
 (hash-eq? (make-immutable-hasheq))
 (hash-eq? (make-immutable-hasheqv))
@@ -137,4 +140,15 @@
 (newline)
 (hash-count (make-hash '((a . a))))
 (hash-count (make-immutable-hash '((b . b)
-                                   (c . d))))
\ No newline at end of file
+                                   (c . d))))
+
+(newline)
+(hash-equal? (make-hash))
+(hash-equal? (make-hasheq))
+(hash-equal? (make-hasheqv))
+(hash-eq? (make-hash))
+(hash-eq? (make-hasheq))
+(hash-eq? (make-hasheqv))
+(hash-eqv? (make-hash))
+(hash-eqv? (make-hasheq))
+(hash-eqv? (make-hasheqv))