問題3.25

(define (make-table same-key?)
  (let ((local-table (list '*table*)))

    (define (assoc2 key records test)
      (cond ((null? records) #f)
            ((test key (caar records)) (car records))
            (else (assoc2 key (cdr records) test))))

    (define (lookup-iter keys table)
      (if (null? keys)
          (cdr table)
          (let ((subtable (assoc2 (car keys) (cdr table) same-key?)))
            (if subtable
                (lookup-iter (cdr keys) subtable)
                #f))))

    (define (lookup keys)
      (lookup-iter keys local-table))

    (define (compose-table keys value)
      (if (null? (cdr keys))
          (cons (car keys) value)
          (list (car keys) (compose-table (cdr keys) value))))

    (define (insert!-iter keys value table)
      (let ((subtable (assoc2 (car keys) (cdr table) same-key?)))
        (if subtable
            (if (null? (cdr keys)) ;; is this last-key?
                (set-cdr! subtable value)
                (insert!-iter (cdr keys) value subtable))
            (set-cdr! table
                      (cons (compose-table keys value)
                            (cdr table))))))

    (define (insert! keys value)
      (insert!-iter keys value 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 ot (make-table eq?))
(define get (ot 'lookup-proc))
(define put (ot 'insert-proc!))

(get '(a b c))
; -> #f
(put '(a b c) 'a-b-c-value)
(put '(a d c) 'a-d-c-value)
(put '(c d e f) 'c-d-e-f-value)
(put '(x y z) 'x-y-z-value)

(get '(a b c))
;a-b-c-value
(get '(a d c))
;a-d-c-value
(get '(x y z))
;x-y-z-value

(get '(c d e f))
;c-d-e-f-value