SICP問題3.25
値が任意個数のキーで格納され、値が異なればキーの個数も異なるかも知れない表の実装
insert!, lookupはアクセスするのにキーのリストを取るということなのでこんな感じで。
(define (make-table same-key?) (let ((local-table (list '*table*))) (define (local-assoc key records) (cond ((null? records) #f) ((same-key? key (caar records)) (car records)) (else (local-assoc key (cdr records))))) (define (lookup-iter key-list records) (if (null? key-list) #f (let ((subtable (local-assoc (car key-list) (cdr records)))) (if subtable (if (null? (cdr key-list)) (cdr subtable) (lookup-iter (cdr key-list) subtable)) #f)))) (define (lookup key-list) (lookup-iter key-list local-table)) (define (insert-iter! key-list value records) (if (null? key-list) #f (let ((subtable (local-assoc (car key-list) (cdr records)))) (if subtable (if (null? (cdr key-list)) (set-cdr! subtable value) (insert-iter! (cdr key-list) value subtable)) (if (null? (cdr key-list)) (set-cdr! records (cons (cons (car key-list) value) (cdr records))) (let ((new-table (list (car key-list)))) (set-cdr! records (cons new-table (cdr records))) (insert-iter! (cdr key-list) value new-table))))))) (define (insert! key-list value) (insert-iter! key-list 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 x (make-table =)) ; x ((x 'insert-proc!) '(1) 'a) ; ok ((x 'insert-proc!) '(2) 'b) ; ok ((x 'lookup-proc) '(1)) ; a ((x 'lookup-proc) '(2)) ; b ((x 'insert-proc!) '(1) 'c) ; ok ((x 'lookup-proc) '(1)) ; c ((x 'insert-proc!) '(3 1) 'x) ; ok ((x 'lookup-proc) '(3 1)) ; x ((x 'insert-proc!) '(4 1 4) 'y) ; ok ((x 'lookup-proc) '(4 1 4)) ; y
以下のように値がすでに設定されているキーに対して、更に深い階層の検索や挿入をしようとするケースはエラーとなる。(上からの続きで)
((x 'insert-proc!) '(1 1) 'a) ; *** ERROR: pair required, but got c ; Stack Trace: ; _______________________________________ ; 0 same-key? ; ; 1 local-assoc ; ; 2 (insert-iter! (cdr key-list) value new-table) ; At line 36 of "c:\\home\\tmurata\\scheme\\3.25-3.scm" ((x 'lookup-proc) '(1 2)) ; *** ERROR: pair required, but got c ; Stack Trace: ; _______________________________________ ; 0 same-key? ; ; 1 local-assoc ;
というところで悩んでいたんですが、Webで他の人の答え見ても同じっぽかったので、これでOKということで。