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