Add exercise 3.24
This commit is contained in:
parent
5287954c87
commit
d1ffdff403
|
@ -0,0 +1,55 @@
|
|||
#lang sicp
|
||||
|
||||
|
||||
(define (make-table same-key?)
|
||||
(let ((local-table (list '*table*)))
|
||||
(define (assoc key records)
|
||||
(cond ((null? records) false)
|
||||
((same-key? key (caar 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)
|
||||
false))
|
||||
false)))
|
||||
(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" m))))
|
||||
dispatch))
|
||||
|
||||
(#%require (only racket/base module+))
|
||||
|
||||
(module+ test
|
||||
(#%require rackunit)
|
||||
|
||||
(define (same-key? k1 k2)
|
||||
(let ((d (abs (- k1 k2))))
|
||||
(< d 10)))
|
||||
|
||||
(test-begin
|
||||
(define t (make-table same-key?))
|
||||
((t 'insert-proc!) 10 10 'a)
|
||||
((t 'insert-proc!) 100 100 'b)
|
||||
(check-equal? ((t 'lookup-proc) 10 10) 'a)
|
||||
(check-equal? ((t 'lookup-proc) 11 11) 'a)
|
||||
(check-equal? ((t 'lookup-proc) 21 21) #f)
|
||||
(check-equal? ((t 'lookup-proc) 100 100) 'b))
|
||||
)
|
Loading…
Reference in New Issue