exercise 3.24
(define (make-table same-key?) (let ((local-table (list '*table*))) (define (assoc key records) (cond ((null? records) #f) ((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) #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" m)))) dispatch)) ;;適当にテスト用の関数↓ (define (nearly-equal? x y) (define tolerance 0.1) (and (< (- y tolerance) x) (< x (+ y tolerance)))) (define operation-table (make-table nearly-equal?)) (define get (operation-table 'lookup-proc)) (define put (operation-table 'insert-proc!))
こんな感じか。というかassocを変えただけだから後半は意味ないなぁ・・・
一応動作確認をば
gosh> (put 1 1 'a) ok gosh> (put 1 2 'b) ok gosh> (get 1.09 1) a gosh> (get 1.09 1.11) #f gosh> (get 1.09 1.91) b gosh> (get 0.91 1.91) b gosh> (get 0.9 1.91) #f