(sicp38)m3.24~m3.26
3.24
equal?以外の述語をとるようにする。
関数を受け取るようにしてみた。
(define (make-table . key) (let ((local-table (list '*table*)) (same-key? equal?)) (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)))) (when (not (null? key)) (set! same-key? (car key))) (print same-key?) dispatch)) (define t (make-table (lambda (x y) #t))) ((t 'insert-proc!) 'a 'b 2) ((t 'lookup-proc) 'a 'b) ((t 'insert-proc!) 'c 'd 9) ((t 'lookup-proc) 'b 'c) ;; 75:user> #<closure #f> ;; => t ;; 76:user> => ok ;; 77:user> => 2 ;; 78:user> => ok ;; 79:user> => 9
3.25
任意個のキーをとれるレコード
(define (make-table . key) (let ((local-table (list '*table*)) (same-key? equal?)) (define (assoc key records) (cond ((null? records) #f) ((same-key? key (caar records)) (car records)) (else (assoc key (cdr records))))) (define (inspect) (print local-table)) (define (lookup keys) (define (loop keys table) (if (null? keys) (cdr table) (let* ((key (car keys)) (rest-keys (cdr keys)) (sub-table (assoc key (cdr table)))) (if sub-table (loop rest-keys sub-table) #f)))) (loop keys local-table)) (define (insert! keys value) (define (loop keys table) (if (null? keys) (set-cdr! table value) (let* ((key (car keys)) (rest-keys (cdr keys)) (sub-table (assoc key (cdr table)))) (if sub-table (loop rest-keys sub-table) (let ((new-table (cons key '()))) (set-cdr! table (cons (loop rest-keys new-table) (cdr table))))))) table) (loop keys local-table) 'ok) (define (dispatch m) (cond ((eq? m 'lookup-proc) lookup) ((eq? m 'insert-proc!) insert!) ((eq? m 'inspect-proc) inspect) (else (error "Unknown operation -- TABLE" m)))) (when (not (null? key)) (set! same-key? (car key))) (print same-key?) dispatch)) (define t (make-table)) ((t 'insert-proc!) '(a b d) 1) ((t 'insert-proc!) '(a b c) 2) ((t 'insert-proc!) '(b c) 'b) ((t 'inspect-proc)) ((t 'lookup-proc) '(a b d)) ;; 27:user> => make-table ;; 28:user> #<subr equal?> ;; => t ;; 29:user> => ok ;; 30:user> => ok ;; 31:user> => ok ;; 32:user> (*table* (b (c . b)) (a (b (c . 2) (d . 1)))) ;; => #<undef> ;; 33:user> => 1