From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Thu, 17 Feb 2011 19:40:55 +0000 (+0530)
Subject: code in the text on tables
X-Git-Url: https://git.rkrishnan.org/pf/content/en/htmlfontify-example.html?a=commitdiff_plain;h=da50a044d141a34ef69b8bcc8a2c09efa9bbcc63;p=sicp.git

code in the text on tables
---

diff --git a/src/sicp/ch3_3_3_1d.rkt b/src/sicp/ch3_3_3_1d.rkt
new file mode 100644
index 0000000..1f8c471
--- /dev/null
+++ b/src/sicp/ch3_3_3_1d.rkt
@@ -0,0 +1,24 @@
+#lang r5rs
+
+(define (lookup key table)
+  (let ((record (assoc key (cdr table))))
+    (if record
+        (cdr record)
+        #f)))
+
+(define (assoc key records)
+  (cond 
+    ((null? records) #f)
+    ((equal? key (car (car records))) (car records))
+    (else (assoc key (cdr records)))))
+
+(define (insert! key value table)
+  (let ((record (assoc key (cdr table))))
+    (if record
+        (set-cdr! record value)
+        (set-cdr! table
+                  (cons (cons key value) (cdr table)))))
+  'ok)
+
+(define (make-table)
+  (list '*table*))
diff --git a/src/sicp/ch3_3_3_2d.rkt b/src/sicp/ch3_3_3_2d.rkt
new file mode 100644
index 0000000..f5c9a5b
--- /dev/null
+++ b/src/sicp/ch3_3_3_2d.rkt
@@ -0,0 +1,25 @@
+#lang r5rs
+
+(define (lookup key-1 key-2 table)
+  (let ((subtable (assoc key-1 (cdr table))))
+    (if subtable
+        (let ((record (assoc key-2 (cdr subtable))))
+          (if record
+              (cdr record)
+              #f))
+        #f)))
+
+(define (insert! key-1 key-2 value table)
+  (let ((subtable (assoc key-1 (cdr table))))
+    (if subtable
+        (let ((record (assoc key-2 (cdr subtable))))
+          (if record
+              (set-cdr! record value)
+              (set-cdr! subtable
+                        (cons (cons key-2 value)
+                              (cdr subtable)))))
+        (set-cdr! table
+                  (cons (list key-1
+                              (cons key-2 value))
+                        (cdr table)))))
+  'ok)
\ No newline at end of file
diff --git a/src/sicp/local-tables.rkt b/src/sicp/local-tables.rkt
new file mode 100644
index 0000000..683e093
--- /dev/null
+++ b/src/sicp/local-tables.rkt
@@ -0,0 +1,44 @@
+#lang r5rs
+
+(define error display)
+
+(define (make-table)
+  (let ((local-table (list '*table*)))
+    (define (assoc key records)
+      (cond 
+        ((null? records) #f)
+        ((equal? key (car (car records))) (car records))
+        (else (assoc key (cdr records)))))
+    
+    (define (lookup key-1 key-2)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (cdr record)
+                  #f))
+            #f)))
+    (define (insert! key-1 key-2 value)
+      (let ((subtable (assoc key-1 (cdr local-table))))
+        (if subtable
+            (let ((record (assoc key-2 (cdr subtable))))
+              (if record
+                  (set-cdr! record value)
+                  (set-cdr! subtable
+                            (cons (cons key-2 value)
+                                  (cdr subtable)))))
+            (set-cdr! local-table 
+                      (cons (list key-1
+                                  (cons key-2 value))
+                            (cdr local-table)))))
+      'ok)
+    (define (dispatch m)
+      (cond
+        ((eq? m 'lookup-proc) lookup)
+        ((eq? m 'insert-proc!) insert!)
+        (else (error "Unknown operation -- TABLE"))))
+    dispatch))
+
+(define operation-table (make-table))
+(define get (operation-table 'lookup-proc))
+(define put (operation-table 'insert-proc!))
\ No newline at end of file