From: Ramakrishnan Muthukrishnan Date: Thu, 17 Feb 2011 19:40:55 +0000 (+0530) Subject: code in the text on tables X-Git-Url: https://git.rkrishnan.org/components/com_hotproperty/frontends/flags/cyclelanguage?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