Xeraph@NCHOVY

아 어렵다 (한숨)
별거 아닌걸로 왜 이리 삽질을..

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (assoc key records)
      (cond ((null? records) false)
            ((equal? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    
    (define (lookup keys)
      (lookup-table keys local-table))
    
    (define (lookup-table keys table)
      (if table
          (if (null? keys)
              (if table  ;; record
                  (cdr table)
                  false)
              (lookup-table (cdr keys) (assoc (car keys) (cdr table))))
          false))

    (define (insert! keys value)
      (create-subtables keys local-table)
      (insert-record keys value local-table)
      'ok)
 
    (define (insert-record keys value table)
      (let ((len (length keys))
            (key (car keys))
            (subtable (assoc (car keys) (cdr table))))
        (if (= len 1)
            (let ((record (assoc (car keys) (cdr table))))
              (if record
                  (set-cdr! record value)
                  (set-cdr! table
                            (cons (cons key value)
                                  (cdr table)))))
            (insert-record (cdr keys) value subtable))))
            
    (define (create-subtables keys table)
      (let ((len (length keys)))
        (if (<= len 1)
            table
            (let ((subtable (assoc (car keys) (cdr table))))
              (if subtable
                  (create-subtables (cdr keys) subtable)
                  (begin
                    (set-cdr! table
                              (cons (cons (car keys) '())
                                    (cdr table)))
                    (create-subtables (cdr keys) (assoc (car keys) (cdr table)))))))))
    
    (define (dispatch m)
      (cond ((eq? m 'lookup) lookup)
            ((eq? m 'insert!) insert!)
            ((eq? m 'get) local-table)
            (else (error "Unknown" m ))))
    dispatch))

(define t (make-table))
((t 'insert!) '(a b c d1 e1) 1)
((t 'insert!) '(a b c d2) 'qoo)
((t 'insert!) '(a b c d1 e2) 2)
((t 'insert!) '(a b c d1 e3) 3)
(t 'get)
((t 'lookup) '(a b c d1 e1))
((t 'lookup) '(a b c d2))
((t 'lookup) '(a b c d1 e2))
((t 'lookup) '(a b c d1 e3))

결과:
ok
ok
ok
ok
(*table* (a (b (c (d2 . qoo) (d1 (e3 . 3) (e2 . 2) (e1 . 1))))))
1
qoo
2
3