SICP 読み (110) 3.3.3 表の表現

正に現実トウヒよろしく、朝イチで着手。今週はダメな週みたいです。
で、二次元の表ですが、どんなリストができるのか、と言いつつ以下の試験をパス。

#!/usr/bin/env gosh

(use test.unit)
(require "3.3.3")

(define-test-suite "3.3.3"

  ("table"
   ("make table"
    (assert-equal '(*table*) (make-table))
    )
   )

  ("assoc"
   ("assoc no-elements"
    (let ((t (make-table)))
      (assert-false (assoc 'a (cdr t))))
    )

    ("assoc match (1)"
     (let ((t (make-table)))
       (set-cdr! t (cons (cons 'a 1) '()))
       (assert-equal '(a . 1) (assoc 'a (cdr t))))
     )

    ("assoc match (2)"
     (let ((t (make-table)))
       (set-cdr! t (cons (cons 'a 1) '()))
       (set-cdr! (cdr t) (cons (cons 'b 2) '()))
       (assert-equal '(b . 2) (assoc 'b (cdr t))))
     )
   )

  ("insert!"
   ("insert 'letters 'a 1"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-equal '(*table* (letters (a . 1))) t)
      )
    )
   )
  )

letters にもう一件追加してみる。先頭側に追加。

   ("insert 'letters 'a 1 and 'letters 'b 2"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-equal 'ok (insert! 'letters 'b 2 t))
      (assert-equal '(*table* (letters (b . 2) (a . 1))) t)
      )
    )

次はテキストにちなんで math に一件追加。

   ("insert 'math '+ 47"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-equal 'ok (insert! 'letters 'b 2 t))
      (assert-equal 'ok (insert! 'math '+ 47 t))
      (assert-equal '(*table* (math (+ . 47))
			      (letters (b . 2) (a . 1))) t)
      )
    )

存在するキーに insert! したら置きかわる。

   ("insert 'letters 'b 48"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-equal 'ok (insert! 'letters 'b 2 t))
      (assert-equal '(*table* (letters (b . 2) (a . 1))) t)
      (assert-equal 'ok (insert! 'letters 'b 48 t))
      (assert-equal '(*table* (letters (b . 48) (a . 1))) t)
      )
    )

次は lookup を。まずは空っぽの表を検索。

  ("lookup"
   ("lookup empty table"
    (let ((t (make-table)))
      (assert-false (lookup 'letters 'a t))
      )
    )
   )

key-1 に存在しないケイス。

   ("lookup error (key-1)"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-false (lookup 'math 'a t))
      )
    )

key-2 に存在しないケイス。

   ("lookup error (key-2)"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-false (lookup 'letters 'b t))
      )
    )

正常系。

   ("lookup normal end"
    (let ((t (make-table)))
      (assert-equal 'ok (insert! 'letters 'a 1 t))
      (assert-equal 1 (lookup 'letters 'a t))
      (assert-equal 'ok (insert! 'math '+ 47 t))
      (assert-equal 47 (lookup 'math '+ t))
      )
    )

以上。