From 4725775126055a421c37b8a8335c8e3ed12d274b Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sat, 23 Jun 2012 23:33:42 -0700
Subject: [PATCH] Implemented contract for immutable id-tables.

---
 collects/syntax/id-table.rkt         |  5 ++++-
 collects/syntax/private/id-table.rkt | 12 +++++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/collects/syntax/id-table.rkt b/collects/syntax/id-table.rkt
index 179c6fea97..fa0471c28f 100644
--- a/collects/syntax/id-table.rkt
+++ b/collects/syntax/id-table.rkt
@@ -73,6 +73,8 @@
                      [idtbl-for-each (s '-for-each)]
                      [idtbl-mutable-methods (s '-mutable-methods)]
                      [idtbl-immutable-methods (s '-immutable-methods)]
+                     [idtbl-chaperone-keys+values/constructor
+                       (s 'idtbl-chaperone-keys+values/constructor)]
                      [idtbl/c (s '/c)])
          #'(begin
 
@@ -187,7 +189,8 @@
                     (lambda (tbl)
                       (check-idtbl/c ctc tbl blame)
                       (if (immutable? tbl)
-                        (error 'idtbl/c "Not Yet implemented")
+                        (idtbl-chaperone-keys+values/constructor
+                          tbl pos-dom-proj pos-rng-proj immutable-idtbl)
                         (chaperone-idtbl tbl
                           (λ (t k)
                             (values (neg-dom-proj k)
diff --git a/collects/syntax/private/id-table.rkt b/collects/syntax/private/id-table.rkt
index e4b3785356..a94219f910 100644
--- a/collects/syntax/private/id-table.rkt
+++ b/collects/syntax/private/id-table.rkt
@@ -264,7 +264,9 @@ Notes (FIXME?):
                      [idtbl-map (s '-map)]
                      [idtbl-for-each (s '-for-each)]
                      [idtbl-mutable-methods (s '-mutable-methods)]
-                     [idtbl-immutable-methods (s '-immutable-methods)])
+                     [idtbl-immutable-methods (s '-immutable-methods)]
+                     [idtbl-chaperone-keys+values/constructor
+                       (s 'idtbl-chaperone-keys+values/constructor)])
          #'(begin
 
              ;; Struct defs at end, so that dict methods can refer to earlier procs
@@ -316,6 +318,13 @@ Notes (FIXME?):
              (define (idtbl-iterate-value d pos)
                (id-table-iterate-value 'idtbl-iterate-value d pos))
 
+             (define (idtbl-chaperone-keys+values/constructor d wrap-key wrap-value constructor)
+               (constructor
+                 (for/hasheq (((sym alist) (idtbl-hash d)))
+                   (for/list (((key value) (in-dict alist)))
+                     (cons (wrap-key key) (wrap-value value))))
+                 (idtbl-phase d)))
+
              (define idtbl-mutable-methods
                (vector-immutable idtbl-ref
                                  idtbl-set!
@@ -366,6 +375,7 @@ Notes (FIXME?):
 
                       ;; just for use/extension by syntax/id-table
                       chaperone-idtbl
+                      idtbl-chaperone-keys+values/constructor
                       idtbl-set/constructor
                       idtbl-remove/constructor
                       idtbl-mutable-methods