section 3.3 done

2 files changed, 38 insertions, 2 deletions

diff --git a/shared/sets.rkt b/shared/sets.rkt
index e20ba7f..7009d87 100644
--- a/shared/sets.rkt
+++ b/shared/sets.rkt
@@ -25,7 +25,7 @@
          (element-of-set? (right-branch mset)))
         ((< x (entry mset))
          (element-of-set? (left-branch mset)))))
-  
+
 (define (adjoin-set x mset)
   (cond ((null? mset) (make-entry x '() '()))
         ((= x (entry mset)) mset)
@@ -105,4 +105,3 @@
   (list->tree
     (ordered-list-intersection-set
         (tree->list set1) (tree->list set2))))
-
diff --git a/shared/table.rkt b/shared/table.rkt
new file mode 100644
index 0000000..be4155e
--- /dev/null
+++ b/shared/table.rkt
@@ -0,0 +1,37 @@
+#lang racket
+(require compatibility/mlist)
+
+(define (make-table same-key?)
+  (let ((local-table (mlist '*table*)))
+    (define (assoc key records)
+      (cond ((null? records) false)
+            ((same-key? key (mcar (mcar records))) (mcar records))
+            (else (assoc key (mcdr records)))))
+    (define (lookup key-1 key-2)
+      (let ((subtable (assoc key-1 (mcdr local-table))))
+        (if subtable
+          (let ((record (assoc key-2 (mcdr subtable))))
+            (if record
+              (mcdr record)
+              false))
+          false)))
+    (define (insert! key-1 key-2 value)
+      (let ((subtable (assoc key-1 (mcdr local-table))))
+        (if subtable
+          (let ((record (assoc key-2 (mcdr subtable))))
+            (if record
+              (set-mcdr! record value)
+              (set-mcdr! subtable
+                         (mcons (mcons key-2 value)
+                                (mcdr subtable)))))
+          (set-mcdr! local-table
+            (mcons (mlist key-1 (mcons key-2 value)) (mcdr local-table)))))
+      'ok)
+    (define (dispatch m)
+      (cond ((eq? m 'lookup-proc) lookup)
+            ((eq? m 'insert-proc) insert!)
+            (else (error "Unknown operation -- TABLE" m))))
+    dispatch))
+(define tbl (make-table (lambda (a b) (equal? a b))))
+((tbl 'insert-proc) 'test 'message "hi")
+((tbl 'lookup-proc) 'test 'message)