From a58fc276c9f1bc7be4c9cda6c82ce7e518d8fc05 Mon Sep 17 00:00:00 2001
From: Ben Greenman <benjaminlgreenman@gmail.com>
Date: Fri, 6 Oct 2017 16:00:50 -0400
Subject: [PATCH] cleanup names, add tests

---
 .../combinators/structural.rkt                |  2 +-
 .../typed-racket/utils/hash-contract.rkt      | 26 +++++++++++++------
 typed-racket-test/succeed/issue-625.rkt       | 23 ++++++++++++++++
 .../static-contract-conversion-tests.rkt      |  6 +++++
 4 files changed, 48 insertions(+), 9 deletions(-)
 create mode 100644 typed-racket-test/succeed/issue-625.rkt

diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt
index b498ae9b..b65011bb 100644
--- a/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt
+++ b/typed-racket-lib/typed-racket/static-contracts/combinators/structural.rkt
@@ -160,7 +160,7 @@
   ((vectorof/sc (#:invariant)) vectorof #:chaperone)
   ((promise/sc (#:covariant)) promise-not-name/c #:chaperone)
   ((syntax/sc (#:covariant #:flat)) syntax/c #:flat)
-  ((hash/sc (#:invariant) (#:invariant)) tr-hash/c #:chaperone)
+  ((hash/sc (#:invariant) (#:invariant)) typed-racket-hash/c #:chaperone)
   ((mutable-hash/sc (#:invariant) (#:invariant)) mutable-hash/c #:chaperone)
   ((immutable-hash/sc (#:covariant) (#:covariant)) immutable-hash/c #:flat)
   ((weak-hash/sc (#:invariant) (#:invariant)) weak-hash/c #:chaperone)
diff --git a/typed-racket-lib/typed-racket/utils/hash-contract.rkt b/typed-racket-lib/typed-racket/utils/hash-contract.rkt
index 75098600..623055a1 100644
--- a/typed-racket-lib/typed-racket/utils/hash-contract.rkt
+++ b/typed-racket-lib/typed-racket/utils/hash-contract.rkt
@@ -1,18 +1,28 @@
 #lang racket/base
 
+;; Typed Racket custom hashtable contracts.
+;; Goals:
+;; - implement contracts for mutable/immutable/weak hashtables
+;; - give a better error message than `racket/contract` when user
+;;   tries to apply "a contract with a non-flat key"
+;;   to a "hashtable that doesn't compare keys with equal?"
+
 (require racket/contract)
-(provide tr-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
+(provide typed-racket-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
+
+(define (typed-racket-hash/c k v)
+  (and/c hash? (hash/c/check-key k v)))
 
 (define (mutable-hash/c k v)
-  (and/c hash? (not/c hash-weak?) (tr-hash/c k v #:immutable #f)))
+  (and/c hash? (not/c hash-weak?) (hash/c/check-key k v #:immutable #f)))
 
 (define (immutable-hash/c k v)
-  (tr-hash/c k v #:immutable #t))
+  (and/c hash? (hash/c/check-key k v #:immutable #t)))
 
 (define (weak-hash/c k v)
-  (and/c hash? hash-weak? (tr-hash/c k v #:immutable #f)))
+  (and/c hash? hash-weak? (hash/c/check-key k v #:immutable #f)))
 
-(define (tr-hash/c k v #:immutable [immutable 'dont-care])
-  (if (flat-contract? k)
-    (hash/c k v #:immutable immutable)
-    (and/c hash? hash-equal? (hash/c k v #:immutable immutable))))
+(define (hash/c/check-key k v #:immutable [immutable 'dont-care])
+  ;; TODO if (flat-contract? k), then make a contract that produces a "good"
+  ;;      error message given a hashtable that is not a `hash-equal?`
+  (hash/c k v #:immutable immutable))
diff --git a/typed-racket-test/succeed/issue-625.rkt b/typed-racket-test/succeed/issue-625.rkt
new file mode 100644
index 00000000..82c795e8
--- /dev/null
+++ b/typed-racket-test/succeed/issue-625.rkt
@@ -0,0 +1,23 @@
+#lang racket/base
+
+;; Hash contracts with non-flat keys should give a good error messages
+;;  when applied to hashes that are not `hash-equal?`
+
+(module t typed/racket/base
+  (provide give-me-a-hash)
+  (: give-me-a-hash (-> (HashTable (Vectorof Symbol) Symbol) Symbol))
+  (define (give-me-a-hash x)
+    'thanks))
+
+(require 't rackunit)
+
+(define err-regexp #rx"expected equal\\?-based hash")
+
+(check-exn err-regexp
+  (λ () (give-me-a-hash (hasheqv))))
+
+(check-exn err-regexp
+  (λ () (give-me-a-hash (hasheq))))
+
+(check-not-exn
+  (λ () (give-me-a-hash (hash))))
diff --git a/typed-racket-test/unit-tests/static-contract-conversion-tests.rkt b/typed-racket-test/unit-tests/static-contract-conversion-tests.rkt
index 22be1782..4dbf87b8 100644
--- a/typed-racket-test/unit-tests/static-contract-conversion-tests.rkt
+++ b/typed-racket-test/unit-tests/static-contract-conversion-tests.rkt
@@ -70,6 +70,12 @@
     (t/sc (-mu sexp (Un -Null -Symbol (-pair sexp sexp) (-vec sexp) (-box sexp))))
     (t/sc (-mu a (-> a a)))
     (t/sc (-seq -Symbol))
+    ;; HashTables with non-flat keys and values (Issue 625)
+    ;;   https://github.com/racket/typed-racket/issues/625
+    (t/sc (-Mutable-HT (-vec -Symbol) (-vec -Symbol)))
+    (t/sc (-Immutable-HT (-vec -Symbol) (-vec -Symbol)))
+    (t/sc (-Weak-HT (-vec -Symbol) (-vec -Symbol)))
+    (t/sc (-HT (-vec -Symbol) (-vec -Symbol)))
     ;; These tests for unit static contracts are insufficient, but
     ;; in order to test Unit types the signature environment must be
     ;; set up correctly. More complex cases of compilation to unit/c