問題3-24 (3.3.2 Representing Tables)

テーブルを作成するところです!
テーブルといっても，perl でいう 2 次元ハッシュですね．

その実装は SICP にはっきりばっちり書いてあるんですけど，問題 3-24 はそのテーブルに，c++ とか java みたく，キーの比較関数を与えられるようにしてねーって問題です．
中で，assoc を再定義してみた．

(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 (round-equal? x y)
  (= (round x) (round y)))

(define table (make-table round-equal?))
(define lookup (table 'lookup-proc))
(define insert! (table 'insert-proc!))
(insert! 1.1 1.11 111)
(insert! 2.2 2.22 222)
(insert! 3.3 3.33 333)
(lookup 1.4 1.46) ; 111
(lookup 2.1 2.55) ; #f