diff --git a/collects/racket/contract/private/hash.rkt b/collects/racket/contract/private/hash.rkt
index af093c70db..1aa5b75d88 100644
--- a/collects/racket/contract/private/hash.rkt
+++ b/collects/racket/contract/private/hash.rkt
@@ -2,107 +2,130 @@
 
 (require "guts.ss")
 
-(provide hash/c)
+(provide (rename-out [build-hash/c hash/c]))
 
-(define (hash/c dom rng #:immutable [immutable 'dont-care])
+(define (build-hash/c dom rng #:immutable [immutable 'dont-care] #:flat? [flat? #f])
   (unless (memq immutable '(#t #f dont-care))
     (error 'hash/c "expected #:immutable argument to be either #t, #f, or 'dont-care, got ~s" immutable))
-  (cond
-    [(eq? immutable #t) 
-     (make-immutable-hash/c (coerce-contract 'hash/c dom) 
-                            (coerce-contract 'hash/c rng))]
-    [else
-     (make-hash/c (coerce-flat-contract 'hash/c dom) 
-                  (coerce-flat-contract 'hash/c rng)
-                  immutable)]))
+  (let ([dom-ctc (if flat?
+                     (coerce-flat-contract 'hash/c dom)
+                     (coerce-contract 'hash/c dom))]
+        [rng-ctc (if flat?
+                     (coerce-flat-contract 'hash/c rng)
+                     (coerce-contract 'hash/c rng))])
+    (if (or flat?
+            (and (eq? immutable #t)
+                 (flat-contract? dom-ctc)
+                 (flat-contract? rng-ctc)))
+        (make-flat-hash/c dom-ctc rng-ctc immutable)
+        (make-ho-hash/c dom-ctc rng-ctc immutable))))
 
-;; hash-test : hash/c -> any -> bool
-(define (hash-test ctc)
-  (let ([dom-proc (flat-contract-predicate (hash/c-dom ctc))]
-        [rng-proc (flat-contract-predicate (hash/c-rng ctc))]
-        [immutable (hash/c-immutable ctc)])
-    (λ (val)
-      (and (hash? val)
-           (case immutable
-             [(#t) (immutable? val)]
-             [(#f) (not (immutable? val))]
-             [(dont-care) #t])
-           (let/ec k
-             (hash-for-each
-              val
-              (λ (dom rng)
-                (unless (dom-proc dom) (k #f))
-                (unless (rng-proc rng) (k #f))))
-             #t)))))
+(define (hash/c-first-order ctc) 
+  (let ([dom-ctc (hash/c-dom ctc)]
+        [rng-ctc (hash/c-rng ctc)]
+        [immutable (hash/c-immutable ctc)]
+        [flat? (flat-hash/c? ctc)])
+    (λ (val #:blame [blame #f])
+      (let/ec return
+        (define (fail . args)
+          (if blame
+              (apply raise-blame-error blame val args)
+              (return #f)))
+        (unless (hash? val)
+          (fail "expected a hash, got ~a" val))
+        (case immutable
+          [(#t) 
+           (unless (immutable? val) 
+             (fail "expected an immutable hash, got ~a" val))]
+          [(#f)
+           (when (immutable? val)
+             (fail "expected an mutable hash, got ~a" val))]
+          [(dont-care) (void)])
+        (when (or flat? (immutable? val))
+          (for ([(k v) (in-hash val)])
+            (if blame
+                (begin (((contract-projection dom-ctc) blame) k)
+                       (((contract-projection rng-ctc) blame) v)
+                       (void))
+                (unless (and (contract-first-order-passes? dom-ctc k)
+                             (contract-first-order-passes? rng-ctc v))
+                  (fail)))))
+        #t))))
 
-(define-struct hash/c (dom rng immutable)
+(define (hash/c-name ctc)
+  (apply 
+   build-compound-type-name
+   'hash/c (hash/c-dom ctc) (hash/c-rng ctc)
+   (append
+    (if (and (flat-hash/c? ctc)
+             (not (eq? (hash/c-immutable ctc) #t)))
+        (list '#:flat? #t)
+        null)
+    (case (hash/c-immutable ctc)
+      [(dont-care) null]
+      [(#t)
+       (list '#:immutable #t)]
+      [(#f)
+       (list '#:immutable #f)]))))
+
+(define-struct hash/c (dom rng immutable))
+
+(define-struct (flat-hash/c hash/c) ()
   #:omit-define-syntaxes
 
   #:property prop:flat-contract
   (build-flat-contract-property
-   #:first-order hash-test
+   #:name hash/c-name
+   #:first-order hash/c-first-order
+   
+   #:projection
+   (λ (ctc)
+     (λ (blame)
+       (λ (val)
+         ((hash/c-first-order ctc) val #:blame blame)
+         val)))))
+
+(define-struct (ho-hash/c hash/c) ()
+  #:omit-define-syntaxes
+
+  #:property prop:contract
+  (build-contract-property
+   #:name hash/c-name
+   #:first-order hash/c-first-order
+   
    #:projection
    (λ (ctc)
       (let ([dom-proc (contract-projection (hash/c-dom ctc))]
             [rng-proc (contract-projection (hash/c-rng ctc))]
             [immutable (hash/c-immutable ctc)])
         (λ (blame)
-           (let ([partial-dom-contract (dom-proc blame)]
-                 [partial-rng-contract (rng-proc blame)])
+           (let ([pos-dom-proj (dom-proc blame)]
+                 [neg-dom-proj (dom-proc (blame-swap blame))]
+                 [pos-rng-proj (rng-proc blame)]
+                 [neg-rng-proj (rng-proc (blame-swap blame))])
              (λ (val)
-                (unless (hash? val)
-                  (raise-blame-error blame val "expected a hash, got ~a" val))
-                (case immutable
-                  [(#t) (unless (immutable? val)
-                          (raise-blame-error blame val
-                                             "expected an immutable hash, got ~a" val))]
-                  [(#f) (when (immutable? val)
-                          (raise-blame-error blame val
-                                             "expected a mutable hash, got ~a" val))]
-                  [(dont-care) (void)])
-                
-                (hash-for-each
-                 val
-                 (λ (key val)
-                    (partial-dom-contract key)
-                    (partial-rng-contract val)))
-                
-                val)))))
-
-   #:name
-   (λ (ctc) (apply 
-             build-compound-type-name
-             'hash/c (hash/c-dom ctc) (hash/c-rng ctc)
-             (if (eq? 'dont-care (hash/c-immutable ctc))
-               '()
-               (list '#:immutable (hash/c-immutable ctc)))))))
-
-(define-struct immutable-hash/c (dom rng)
-  #:omit-define-syntaxes
-
-  #:property prop:contract
-  (build-contract-property
-   #:first-order (λ (ctc) (λ (val) (and (hash? val) (immutable? val))))
-   #:projection
-   (λ (ctc)
-      (let ([dom-proc (contract-projection (immutable-hash/c-dom ctc))]
-            [rng-proc (contract-projection (immutable-hash/c-rng ctc))])
-        (λ (blame)
-           (let ([partial-dom-contract (dom-proc blame)]
-                 [partial-rng-contract (rng-proc blame)])
-             (λ (val)
-                (unless (and (hash? val)
-                             (immutable? val))
-                  (raise-blame-error blame val
-                                     "expected an immutable hash"))
-                (make-immutable-hash
-                 (hash-map
-                  val
-                  (λ (k v)
-                     (cons (partial-dom-contract k)
-                           (partial-rng-contract v))))))))))
-
-   #:name
-   (λ (ctc) (build-compound-type-name
-             'hash/c (immutable-hash/c-dom ctc) (immutable-hash/c-rng ctc)
-             '#:immutable #t))))
\ No newline at end of file
+               ((hash/c-first-order ctc) val #:blame blame)
+               
+               (if (immutable? val)
+                   (let ([hash-maker
+                          (cond
+                            [(hash-equal? val) make-immutable-hash]
+                            [(hash-eqv? val) make-immutable-hasheqv]
+                            [(hash-eq? val) make-immutable-hasheq])])
+                     (hash-maker
+                      (for/list ([(k v) (in-hash val)])
+                        (cons (pos-dom-proj k)
+                              (pos-rng-proj v)))))
+                   (proxy-hash
+                    val
+                    (λ (h k)
+                      (values (neg-dom-proj k)
+                              (λ (h k v)
+                                (pos-rng-proj v))))
+                    (λ (h k v)
+                      (values (neg-dom-proj k)
+                              (neg-rng-proj v)))
+                    (λ (h k)
+                      (neg-dom-proj k))
+                    (λ (h k)
+                      (pos-dom-proj k)))))))))))
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index ae4b56dfb0..dd32a693fc 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -3531,6 +3531,46 @@
               'pos
               'neg))
   
+  (test/spec-passed
+   'hash/c1b
+   '(contract (hash/c symbol? boolean? #:flat? #t)
+              (make-hash)
+              'pos
+              'neg))
+  
+  (test/spec-passed
+   'hash/c1c
+   '(let ([h (contract (hash/c symbol? boolean?)
+                       (make-hash)
+                       'pos
+                       'neg)])
+      (hash-set! h 'x #t)
+      (hash-ref h 'x)))
+  
+  (test/neg-blame
+   'hash/c1d
+   '(let ([h (contract (hash/c symbol? boolean?)
+                       (make-hash)
+                       'pos
+                       'neg)])
+      (hash-set! h 3 #t)))
+  
+  (test/neg-blame
+   'hash/c1e
+   '(let ([h (contract (hash/c symbol? boolean?)
+                       (make-hash)
+                       'pos
+                       'neg)])
+      (hash-set! h 'x 3)))
+  
+  (test/neg-blame
+   'hash/c1f
+   '(let ([h (contract (hash/c symbol? boolean?)
+                       (make-hash)
+                       'pos
+                       'neg)])
+      (hash-ref h 3)))
+  
   (test/spec-passed
    'hash/c2
    '(contract (hash/c symbol? boolean?)
@@ -8781,10 +8821,24 @@ so that propagation occurs.
                             (define-struct s (a b))
                             (struct/c s any/c any/c)))
   
-  (ctest #t flat-contract? (hash/c any/c any/c #:immutable #f))
-  (ctest #f flat-contract? (hash/c any/c any/c #:immutable #t))
-  (ctest #t flat-contract? (hash/c any/c any/c))
+  (ctest #t contract?      (hash/c any/c any/c #:immutable #f))
+  (ctest #t flat-contract? (hash/c any/c any/c #:immutable #f #:flat? #t))
+
+  (ctest #t flat-contract? (hash/c any/c any/c #:immutable #t))
+  (ctest #t flat-contract? (hash/c any/c any/c #:immutable #t #:flat? #t))
+
+  (ctest #t contract?      (hash/c any/c any/c))
+  (ctest #t flat-contract? (hash/c any/c any/c #:flat? #t))
   
+  (ctest #t contract?      (hash/c number? (-> number? number?) #:immutable #f))
+  (ctest #f flat-contract? (hash/c number? (-> number? number?) #:immutable #f))
+
+  (ctest #t contract?      (hash/c number? (-> number? number?) #:immutable #t))
+  (ctest #f flat-contract? (hash/c number? (-> number? number?) #:immutable #t))
+  
+  (ctest #t contract?      (hash/c number? (-> number? number?)))
+  (ctest #f flat-contract? (hash/c number? (-> number? number?)))
+
   (ctest #t contract? 1)
   (ctest #t contract? (-> 1 1))
   
@@ -8887,15 +8941,15 @@ so that propagation occurs.
                       '(1 2 3 4)
                       '(1 2 3))
 
-  (test-flat-contract '(hash/c symbol? boolean?) (make-hash) 1)
-  (test-flat-contract '(hash/c symbol? boolean?) 
+  (test-flat-contract '(hash/c symbol? boolean? #:flat? #t) (make-hash) 1)
+  (test-flat-contract '(hash/c symbol? boolean? #:flat? #t) 
                       (let ([ht (make-hash)])
                         (hash-set! ht 'x #t)
                         ht)
                       (let ([ht (make-hash)])
                         (hash-set! ht 'x 1)
                         ht))
-  (test-flat-contract '(hash/c symbol? boolean?) 
+  (test-flat-contract '(hash/c symbol? boolean? #:flat? #t) 
                       (let ([ht (make-hash)])
                         (hash-set! ht 'x #t)
                         ht)
@@ -9497,12 +9551,16 @@ so that propagation occurs.
   
   (ctest #t contract-first-order-passes? (hash/c any/c any/c) (make-hash))
   (ctest #f contract-first-order-passes? (hash/c any/c any/c) #f)
-  (ctest #f contract-first-order-passes? (hash/c symbol? boolean?) (let ([ht (make-hash)])
+  (ctest #t contract-first-order-passes? (hash/c symbol? boolean?) (let ([ht (make-hash)])
                                                                      (hash-set! ht 'x 1)
                                                                      ht))
-  (ctest #f contract-first-order-passes? (hash/c symbol? boolean?) (let ([ht (make-hash)])
+  (ctest #f contract-first-order-passes? (hash/c symbol? boolean? #:flat? #t)
+         (let ([ht (make-hash)]) (hash-set! ht 'x 1) ht))
+  (ctest #t contract-first-order-passes? (hash/c symbol? boolean?) (let ([ht (make-hash)])
                                                                      (hash-set! ht 1 #f)
                                                                      ht))
+  (ctest #f contract-first-order-passes? (hash/c symbol? boolean? #:flat? #t)
+         (let ([ht (make-hash)]) (hash-set! ht 1 #f) ht))
   (ctest #t contract-first-order-passes? (hash/c symbol? boolean?) (let ([ht (make-hash)])
                                                                      (hash-set! ht 'x #t)
                                                                      ht))