SICPゼミ第19回

練習問題3.24

(define (make-table same-key?)
  (let ((table (list '*table*)))
    (define (lookup key)
      (let ((record (assoc key (cdr table))))
        (if record
            (cdr record)
            #f)))
    (define (assoc key records)
      (cond ((null? records) #f)
            ((same-key? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    (define (insert! key value)
      (let ((record (assoc key (cdr table))))
        (if record
            (set-cdr! record value)
            (set-cdr! table
                      (cons (cons key value)
                            (cdr table )))))
      'ok)
    (define (dispatch m)
      (cond ((eq? m 'lookup) lookup)
            ((eq? m 'insert!) insert!)))
    dispatch))

by pine

練習問題3.25

(define (make-table)
  (let ((table (list '*table*)))
    (define (lookup keys)
      (define (lookup-iter keys subtable)
        (let ((record (assoc (car keys) (cdr subtable))))
          (if record
              (if (null? (cdr keys))
                  (cdr record)
                  (lookup-iter (cdr keys) record))
              #f)))
      (lookup-iter keys table))
    (define (assoc key records)
      (cond ((null? records) #f)
            ((equal? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    (define (insert! keys value)
      (define (insert-iter! keys subtable)
        (let ((record (assoc (car keys) (cdr subtable))))
          (if (null? (cdr keys))
              (if record
                  (set-cdr! record value)
                  (set-cdr! subtable (cons (cons (car keys) value)
                                           (cdr subtable))))
              (if record
                  (insert-iter! (cdr keys) record)
                  (begin
                    (set-cdr! subtable (cons (cons (car keys) nil) (cdr subtable)))
                    (insert-iter! (cdr keys) (cadr subtable)))))))
      (begin
        (insert-iter! keys table)
        'ok))
    (define (dispatch m)
      (cond ((eq? m 'lookup) lookup)
            ((eq? m 'insert!) insert!)
            ((eq? m 'get) table)
            (else (error "Undefined message"))))
    dispatch))

by pine

練習問題3.26

(define (make-multitree n) (cons 'multitree (cons n nil)))

(define (lookup-multitree keys tree)
  (define (lookup-multitree-iter keys tree)
    (if (null? tree)
      #f
      (let ((refkey (caar tree)) (key (car keys)))
        (cond
          ((eq? key refkey) 
            (if (null? (cdr keys))
              (cdar tree)
              (lookup-multitree-iter (cdr keys) (cdar tree))
              )
            )
          ((< key refkey) (lookup-multitree-iter keys (cadr tree)))
          (else (lookup-multitree-iter keys (caddr tree)))
          )
        )
      )
    )
  (lookup-multitree-iter keys (cddr tree))
  )

(define (insert-multitree! keys item tree)
  (define (make-sub-tree keys item)
    (if (null? (cdr keys))
      (list (cons (car keys) item) nil nil)
      (list (cons (car keys) (make-sub-tree (cdr keys) item)) nil nil)
      )
    )
  (define (insert-multitree-iter! keys item tree parent)
    (if (null? tree)
      (set-car! parent (make-sub-tree keys item))
      (let ((refkey (caar tree)) (key (car keys)))
        (cond
          ((eq? refkey key) 
            (if (null? (cdr keys))
              (set-cdr! (car tree) item)
              (insert-multitree-iter! (cdr keys) item (cdar tree) nil)
              )
            )
          ((< key refkey) (insert-multitree-iter! keys item (cadr tree) (cdr tree)))
          (else (insert-multitree-iter! keys item (caddr tree) (cddr tree)))
          )
        )
      )
    )

  (if (eq? (length keys) (cadr tree))
    (if (null? (cddr tree))
      (set! (cddr tree) (make-sub-tree keys item))
      (insert-multitree-iter! keys item (cddr tree) nil)
      )
    (error "hoge")
    )
  )

by dolicas