diff --git a/collects/syntax/id-table.rkt b/collects/syntax/id-table.rkt
index d9c01ecd0d..533b08e7aa 100644
--- a/collects/syntax/id-table.rkt
+++ b/collects/syntax/id-table.rkt
@@ -64,7 +64,7 @@
           idtbl-map idtbl-for-each
           idtbl-mutable-methods idtbl-immutable-methods
           idtbl/c
-          chaperone-idtbl idtbl-chaperone-keys+values/constructor))
+          chaperone-mutable-idtbl chaperone-immutable-idtbl))
        #'(begin
 
            ;; Struct defs at end, so that dict methods can refer to earlier procs
@@ -130,7 +130,7 @@
                (define (proj acc location swap)
                  (lambda (ctc blame)
                    ((contract-projection (acc ctc))
-                    (blame-add-context blame "the keys of" #:swap swap))))
+                    (blame-add-context blame location #:swap? swap))))
                (values
                  (proj base-idtbl/c-dom "the keys of" #f)
                  (proj base-idtbl/c-dom "the keys of" #t)
@@ -144,8 +144,8 @@
              (λ (val)
                (and (idtbl? val)
                     (case immutable
-                      [(#t) (immutable? val)]
-                      [(#f) (not (immutable? val))]
+                      [(#t) (immutable-idtbl? val)]
+                      [(#f) (mutable-idtbl? val)]
                       [else #t])
                     (for/and ([(k v) (in-dict val)])
                       (and (contract-first-order-passes? dom-ctc k)
@@ -158,11 +158,11 @@
                  '(expected "a ~a," given: "~e") 'idtbl val))
              (case immutable
                [(#t)
-                (unless (immutable? val)
+                (unless (immutable-idtbl? val)
                   (raise-blame-error blame val
                     '(expected "an immutable ~a," given: "~e") 'idtbl val))]
                [(#f)
-                (when (immutable? val)
+                (unless (mutable-idtbl? val)
                   (raise-blame-error blame val
                     '(expected "a mutable ~a," given: "~e") 'idtbl val))]
                [(dont-care) (void)]))
@@ -170,29 +170,30 @@
            (define ho-projection
              (lambda (ctc)
                (lambda (blame)
-                (lambda (b)
-                  (define pos-dom-proj (idtbl/c-dom-pos-proj ctc blame))
-                  (define neg-dom-proj (idtbl/c-dom-pos-proj ctc blame))
-                  (define pos-rng-proj (idtbl/c-dom-pos-proj ctc blame))
-                  (define neg-rng-proj (idtbl/c-dom-pos-proj ctc blame))
-                  (lambda (tbl)
-                    (check-idtbl/c ctc tbl blame)
-                    (if (immutable? tbl)
-                      (idtbl-chaperone-keys+values/constructor
-                        tbl pos-dom-proj pos-rng-proj immutable-idtbl)
-                      (chaperone-idtbl tbl
-                        (λ (t k)
-                          (values (neg-dom-proj k)
-                                  (λ (h k v)
-                                    (pos-rng-proj v))))
-                        (λ (t k v)
-                          (values (neg-dom-proj k)
-                                  (neg-rng-proj v)))
-                        (λ (t k)
-                          (neg-dom-proj k))
-                        (λ (t k)
-                          (pos-dom-proj k))
-                        impersonator-prop:contracted ctc)))))))
+                 (define pos-dom-proj (idtbl/c-dom-pos-proj ctc blame))
+                 (define neg-dom-proj (idtbl/c-dom-neg-proj ctc blame))
+                 (define pos-rng-proj (idtbl/c-rng-pos-proj ctc blame))
+                 (define neg-rng-proj (idtbl/c-rng-neg-proj ctc blame))
+                 (lambda (tbl)
+                   (check-idtbl/c ctc tbl blame)
+                   ;TODO for immutable hash tables optimize this chaperone to a flat
+                   ;check if possible
+                   (if (immutable-idtbl? tbl)
+                     (chaperone-immutable-idtbl tbl pos-dom-proj pos-rng-proj
+                      impersonator-prop:contracted ctc)
+                     (chaperone-mutable-idtbl tbl
+                       (λ (t k)
+                         (values (neg-dom-proj k)
+                                 (λ (h k v)
+                                   (pos-rng-proj v))))
+                       (λ (t k v)
+                         (values (neg-dom-proj k)
+                                 (neg-rng-proj v)))
+                       (λ (t k)
+                         (neg-dom-proj k))
+                       (λ (t k)
+                         (pos-dom-proj k))
+                       impersonator-prop:contracted ctc))))))
 
 
 
@@ -207,8 +208,8 @@
                 (λ (blame)
                   (λ (val)
                     (check-idtbl/c ctc val blame)
-                    (define dom-proj (idtbl/c-dom-pos-proj ctc))
-                    (define rng-proj (idtbl/c-rng-pos-proj ctc))
+                    (define dom-proj (idtbl/c-dom-pos-proj ctc blame))
+                    (define rng-proj (idtbl/c-rng-pos-proj ctc blame))
                     (for ([(k v) (in-dict val)])
                       (dom-proj k)
                       (rng-proj v))
diff --git a/collects/syntax/private/id-table.rkt b/collects/syntax/private/id-table.rkt
index abaa3544f1..1f3726db23 100644
--- a/collects/syntax/private/id-table.rkt
+++ b/collects/syntax/private/id-table.rkt
@@ -2,7 +2,8 @@
 (require (for-syntax racket/base
                      racket/syntax)
          (for-meta 2 racket/base)
-         racket/private/dict)
+         racket/private/dict
+         racket/promise)
 
 ;; No-contract version.
 
@@ -11,6 +12,13 @@
 ;;       phase is a phase-level (integer or #f)
 
 
+
+(define (id-table-hash-code d hash-code)
+  (+ (hash-code (id-table-phase d))
+     (for/sum (((k v) (in-dict d)))
+       (* (hash-code (syntax-e k)) (hash-code v)))))
+
+
 (define-values (prop:id-table-impersonator
                 id-table-impersonator?
                 id-table-impersonator-value)
@@ -44,47 +52,50 @@
     (id-table-set/constructor who t k v make identifier->symbol identifier=?)))
 
 (define (id-table-ref who d id default identifier->symbol identifier=?)
-  (if (id-table-impersonator? d)
-       (let-values (((new-id return-wrapper)
-                     ((id-table-imp-ref-wrapper d) d id)))
-         (return-wrapper
-           (id-table-ref (id-table-imp-wrapped d) new-id default)))
-       (let ([phase (id-table-phase d)])
-         (let ([i (for/first ([i (in-list (hash-ref (id-table-hash d)
-                                                    (identifier->symbol id phase)
-                                                    null))]
-                              #:when (identifier=? (car i) id phase))
-                    i)])
-           (if i
-               (cdr i)
-               (cond [(eq? default not-given)
-                      (error who "no mapping for ~e" id)]
-                     [(procedure? default) (default)]
-                     [else default]))))))
+  (let loop ((d d) (id id) (return values))
+    (if (id-table-impersonator? d)
+         (let-values (((new-id return-wrapper)
+                       ((id-table-imp-ref-wrapper d) d id)))
+             (loop (id-table-imp-wrapped d) new-id
+                   (lambda (new-v) (return-wrapper d new-id new-v))))
+         (let ([phase (id-table-phase d)])
+           (let ([i (for/first ([i (in-list (hash-ref (id-table-hash d)
+                                                      (identifier->symbol id phase)
+                                                      null))]
+                                #:when (identifier=? (car i) id phase))
+                      i)])
+             (if i
+                 (return (cdr i))
+                 (cond [(eq? default not-given)
+                        (error who "no mapping for ~e" id)]
+                       [(procedure? default) (default)]
+                       [else default])))))))
 
 (define (id-table-set! who d id v identifier->symbol identifier=?)
-  (if (id-table-impersonator? d)
-      (let-values (((new-id new-v)
-                    ((id-table-imp-set!-wrapper d) d id v)))
-        (id-table-set! (id-table-imp-wrapped d) new-id new-v))
-      (let* ([phase (id-table-phase d)]
-             [sym (identifier->symbol id phase)]
-             [l (hash-ref (id-table-hash d) sym null)]
-             [new-l (alist-set identifier=? phase l id v)])
-        (hash-set! (id-table-hash d) sym new-l))))
+  (let loop ((d d) (id id) (v v))
+    (if (id-table-impersonator? d)
+        (let-values (((new-id new-v)
+                      ((id-table-imp-set!-wrapper d) d id v)))
+          (loop (id-table-imp-wrapped d) new-id new-v))
+        (let* ([phase (id-table-phase d)]
+               [sym (identifier->symbol id phase)]
+               [l (hash-ref (id-table-hash d) sym null)]
+               [new-l (alist-set identifier=? phase l id v)])
+          (hash-set! (id-table-hash d) sym new-l)))))
 
 
 (define (id-table-remove! who d id identifier->symbol identifier=?)
-  (if (id-table-impersonator? d)
-      (let ((new-id ((id-table-imp-remove!-wrapper d) d id)))
-        (id-table-remove! (id-table-imp-wrapped d) new-id))
-      (let* ([phase (id-table-phase d)]
-             [sym (identifier->symbol id phase)]
-             [l (hash-ref (id-table-hash d) sym null)]
-             [newl (alist-remove identifier=? phase l id)])
-        (if (pair? newl)
-            (hash-set! (id-table-hash d) sym newl)
-            (hash-remove! (id-table-hash d) sym)))))
+  (let loop ((d d) (id id))
+    (if (id-table-impersonator? d)
+        (let ((new-id ((id-table-imp-remove!-wrapper d) d id)))
+          (loop (id-table-imp-wrapped d) new-id))
+        (let* ([phase (id-table-phase d)]
+               [sym (identifier->symbol id phase)]
+               [l (hash-ref (id-table-hash d) sym null)]
+               [newl (alist-remove identifier=? phase l id)])
+          (if (pair? newl)
+              (hash-set! (id-table-hash d) sym newl)
+              (hash-remove! (id-table-hash d) sym))))))
 
 (define (id-table-set/constructor who d id v constructor identifier->symbol identifier=?)
   (let* ([phase (id-table-phase d)]
@@ -108,14 +119,6 @@
 (define (id-table-count d)
   (apply + (hash-map (id-table-hash d) (lambda (k v) (length v)))))
 
-(define (id-table-for-each d p)
-  (define (pp i) (p (car i) (cdr i)))
-  (hash-for-each (id-table-hash d) (lambda (k v) (for-each pp v))))
-
-(define (id-table-map d f)
-  (define (fp i) (f (car i) (cdr i)))
-  (apply append (hash-map (id-table-hash d) (lambda (k v) (map fp v)))))
-
 
 (define-struct id-table-iter (d a br b))
 ;; where d is an id-table
@@ -154,20 +157,20 @@ Notes (FIXME?):
 (define (id-table-iterate-key who d pos)
   (if (id-table-impersonator? d)
       (let ((wrapper (id-table-imp-key-wrapper d)))
-        (wrapper (id-table-iterate-key (id-table-imp-wrapped d) pos)))
+        (wrapper d (id-table-iterate-key who (id-table-imp-wrapped d) pos)))
     (let-values ([(h a br b) (rebase-iter who d pos)])
       (caar b))))
 
 ;; TODO figure out how to provide API compatibility with hashes with regards
 ;; to iterate-key and provide the checking from rebase-iter
-(define (id-table-iterate-value who d pos)
+(define (id-table-iterate-value who d pos identifier->symbol identifier=?)
  (if (id-table-impersonator? d)
-     (id-table-ref d (id-table-iterate-key d pos))
+     (id-table-ref who d (id-table-iterate-key who d pos) not-given identifier->symbol identifier=?)
      (let-values ([(h a br b) (rebase-iter who d pos)])
        (cdar b))))
 
 (define (rebase-iter who d pos)
-  (unless (eq? d (id-table-iter-d pos))
+  (unless (chaperone-of? (id-table-iter-d pos) d)
     (error who "invalid iteration position for identifier table"))
   (let* ([h (id-table-hash d)]
          [a (id-table-iter-a pos)]
@@ -260,7 +263,7 @@ Notes (FIXME?):
           idtbl-iterate-key idtbl-iterate-value
           idtbl-map idtbl-for-each
           idtbl-mutable-methods idtbl-immutable-methods
-          chaperone-idtbl idtbl-chaperone-keys+values/constructor))
+          chaperone-mutable-idtbl chaperone-immutable-idtbl))
        #'(begin
 
            ;; Struct defs at end, so that dict methods can refer to earlier procs
@@ -274,13 +277,26 @@ Notes (FIXME?):
              (make-immutable-id-table/constructor 'make-immutable-idtbl init-dict phase immutable-idtbl
                                                   identifier->symbol identifier=?))
 
-           (define (chaperone-idtbl d ref set! remove! key . args)
+           (define (chaperone-mutable-idtbl d ref set! remove! key . args)
              (apply chaperone-struct d
                id-table-phase (lambda (d p) p)
                prop:id-table-impersonator
                (vector d ref set! remove! key)
                args))
 
+           (define (chaperone-immutable-idtbl d wrap-key wrap-value . args)
+             (define cached-hash
+               (delay
+                 (for/hasheq (((sym alist) (id-table-hash d)))
+                   (values sym
+                     (for/list (((key value) (in-dict alist)))
+                       (cons (wrap-key key) (wrap-value value)))))))
+             (apply chaperone-struct d
+               id-table-hash (lambda (d h)
+                            (force cached-hash))
+               args))
+
+
 
            (define (idtbl-ref d id [default not-given])
              (id-table-ref 'idtbl-ref d id default identifier->symbol identifier=?))
@@ -300,9 +316,9 @@ Notes (FIXME?):
            (define (idtbl-count d)
              (id-table-count d))
            (define (idtbl-for-each d p)
-             (id-table-for-each d p))
+             (dict-for-each d p))
            (define (idtbl-map d f)
-             (id-table-map d f))
+             (dict-map d f))
            (define (idtbl-iterate-first d)
              (id-table-iterate-first d))
            (define (idtbl-iterate-next d pos)
@@ -310,13 +326,14 @@ Notes (FIXME?):
            (define (idtbl-iterate-key d pos)
              (id-table-iterate-key 'idtbl-iterate-key d pos))
            (define (idtbl-iterate-value d pos)
-             (id-table-iterate-value 'idtbl-iterate-value d pos))
+             (id-table-iterate-value 'idtbl-iterate-value d pos identifier->symbol identifier=?))
 
            (define (idtbl-chaperone-keys+values/constructor d wrap-key wrap-value constructor)
              (constructor
                (for/hasheq (((sym alist) (id-table-hash d)))
-                 (for/list (((key value) (in-dict alist)))
-                   (cons (wrap-key key) (wrap-value value))))
+                 (values sym
+                   (for/list (((key value) (in-dict alist)))
+                     (cons (wrap-key key) (wrap-value value)))))
                (id-table-phase d)))
 
            (define idtbl-mutable-methods
@@ -343,11 +360,22 @@ Notes (FIXME?):
                                idtbl-iterate-key
                                idtbl-iterate-value))
 
+           (define (idtbl-equal? left right equal?)
+             (let/ec k
+               (and (equal? (id-table-phase left) (id-table-phase right))
+                    (equal? (idtbl-count left) (idtbl-count right))
+                    (for/and (((l-key l-value) (in-dict left)))
+                      (equal? (idtbl-ref right l-key (lambda () (k #f))) l-value)))))
+
+
            (struct idtbl id-table ())
            (struct mutable-idtbl idtbl ()
-             #:property prop:dict idtbl-mutable-methods)
+             #:property prop:dict idtbl-mutable-methods
+             #:property prop:equal+hash (list idtbl-equal? id-table-hash-code id-table-hash-code))
+
            (struct immutable-idtbl idtbl ()
-             #:property prop:dict idtbl-immutable-methods)
+             #:property prop:dict idtbl-immutable-methods
+             #:property prop:equal+hash (list idtbl-equal? id-table-hash-code id-table-hash-code))
 
            (provide make-idtbl
                     make-immutable-idtbl
@@ -368,8 +396,8 @@ Notes (FIXME?):
                     idtbl-for-each
 
                     ;; just for use/extension by syntax/id-table
-                    chaperone-idtbl
-                    idtbl-chaperone-keys+values/constructor
+                    chaperone-mutable-idtbl
+                    chaperone-immutable-idtbl
                     idtbl-set/constructor
                     idtbl-remove/constructor
                     idtbl-mutable-methods
diff --git a/collects/tests/racket/id-table-test.rktl b/collects/tests/racket/id-table-test.rktl
index 3e48a5ecdc..d4cefe6924 100644
--- a/collects/tests/racket/id-table-test.rktl
+++ b/collects/tests/racket/id-table-test.rktl
@@ -241,6 +241,97 @@
                (lambda (x y)
                  (set! l (cons y l))))
               l))
-      )))
+      ))
+
+  (test #t contract? (free-id-table/c any/c number?))
+  (test #t contract? (bound-id-table/c any/c number?))
+  (test #t contract? (bound-id-table/c any/c number? #:immutable #t))
+  (test #t contract? (free-id-table/c any/c number? #:immutable #f))
+  (test #t contract? (bound-id-table/c any/c number? #:immutable 'dont-care))
+
+  (test #t chaperone-contract? (free-id-table/c any/c number?))
+  (test #f flat-contract? (free-id-table/c any/c number?))
+  (test #t flat-contract? (free-id-table/c any/c number? #:immutable #t))
+  (test #f flat-contract? (free-id-table/c any/c (vectorof number?) #:immutable #t))
+  (test #f chaperone-contract? (free-id-table/c any/c (new-∀/c 'v)))
+  (error-test #'(free-id-table/c (new-∀/c 'v) any/c))
+
+  (let ()
+
+    (define (app-ctc ctc value)
+      (contract ctc value 'positive 'negative))
+
+    (define (positive-error? exn)
+      (and exn:fail:contract?
+           (regexp-match? "blaming: positive" (exn-message exn))))
+    (define (negative-error? exn)
+      (and exn:fail:contract?
+           (regexp-match? "blaming: negative" (exn-message exn))))
+
+    (define-syntax-rule (test/blame-pos e)
+     (thunk-error-test (lambda () e) #'e positive-error?))
+    (define-syntax-rule (test/blame-neg e)
+     (thunk-error-test (lambda () e) #'e negative-error?))
+
+    (define-values (a b c d) (values 'A 'B 'C 'D))
+    (define tbl (make-free-id-table))
+    (free-id-table-set! tbl #'a a)
+    (free-id-table-set! tbl #'b b)
+    (free-id-table-set! tbl #'c c)
+    (free-id-table-set! tbl #'d d)
+
+    (define im-tbl
+      ((compose
+         (lambda (tbl) (free-id-table-set tbl #'a a))
+         (lambda (tbl) (free-id-table-set tbl #'b b))
+         (lambda (tbl) (free-id-table-set tbl #'c c))
+         (lambda (tbl) (free-id-table-set tbl #'d d)))
+       (make-immutable-free-id-table)))
+
+
+    (test #t free-id-table? (app-ctc (free-id-table/c any/c any/c) (make-free-id-table)))
+    (test #t bound-id-table? (app-ctc (bound-id-table/c identifier? number?) (make-bound-id-table)))
+    (test #t free-id-table? (app-ctc (free-id-table/c identifier? symbol?) tbl))
+    (test #t free-id-table? (app-ctc (free-id-table/c identifier? symbol?) im-tbl))
+    (test #t free-id-table? (app-ctc (free-id-table/c identifier? number?) tbl))
+
+
+    (test/blame-pos (app-ctc (free-id-table/c symbol? symbol? #:immutable #t) im-tbl))
+    (test/blame-pos (app-ctc (free-id-table/c identifier? number? #:immutable #t) im-tbl))
+    (test #t free-id-table? (app-ctc (free-id-table/c identifier? number?) im-tbl))
+    (test #t free-id-table? (app-ctc (free-id-table/c symbol? symbol?) im-tbl))
+
+    ; These are not failures yet because they are not flat contracts
+    ; Looking at the hash ensures that the contract fails
+    ;(test/blame-pos (app-ctc (free-id-table/c identifier? number?) im-tbl))
+    ;(test/blame-pos (app-ctc (free-id-table/c symbol? symbol?) im-tbl))
+    (test/blame-pos (free-id-table-count (app-ctc (free-id-table/c identifier? number?) im-tbl)))
+    (test/blame-pos (free-id-table-count (app-ctc (free-id-table/c symbol? symbol?) im-tbl)))
+
+    (define (short-identifier? id)
+      (and (identifier? id) (equal? 1 (string-length (symbol->string (syntax-e id))))))
+    (define ctced-tbl (app-ctc (free-id-table/c short-identifier? number?) tbl))
+    (test/blame-pos (free-id-table-ref ctced-tbl #'a))
+    (test/blame-neg (free-id-table-ref ctced-tbl #'ab))
+    (test/blame-neg (free-id-table-set! ctced-tbl #'a 'c))
+    (test/blame-neg (free-id-table-set! ctced-tbl #'ab 2))
+    (test/blame-neg (free-id-table-remove! ctced-tbl #'ab))
+
+    (test/blame-pos
+      (let ((ctced-tbl (app-ctc (free-id-table/c symbol? number?) tbl)))
+        (free-id-table-iterate-key ctced-tbl (free-id-table-iterate-first ctced-tbl))))
+    
+    (define/contract ctc-tbl (free-id-table/c any/c number?) (make-free-id-table))
+    (test #t void? (free-id-table-set! ctc-tbl #'a 1))
+    (test #t void? (free-id-table-set! ctc-tbl #'b 2))
+    (test #t number? (free-id-table-ref ctc-tbl #'b))
+    (test #t string? (free-id-table-ref ctc-tbl #'c "3"))
+    (test #t void? (free-id-table-set! ctc-tbl #'a 4))
+    (test #t void? (free-id-table-remove! ctc-tbl #'b))
+    (test #t number? (free-id-table-count ctc-tbl))
+    (test #t list? (free-id-table-map ctc-tbl (λ (k v) v)))
+
+
+    ))
 
 (report-errs)