EoPL reading (130) 2.4 A Queue Abstraction

よく考えたら 2.4 でした。で試験も書いたので以下にて。
まず実装が以下。

(add-load-path ".")
(load "define-datatype")

(define-datatype reference reference?
  (a-ref
    (position integer?)
    (vec vector?)))

(define cell
  (lambda (pos datum)
    (let ((ref (a-ref pos (vector datum))))
      (letrec ((cell? (lambda () #t))
	       (contents (lambda ()
			   (vector-ref (caddr ref) 0)))
	       (setcell (lambda (val)
			  (set! ref (a-ref pos (vector val))))))
	(vector cell? contents setcell)))))

(define cell-get-predicate-operation
  (lambda (c) (vector-ref c 0)))
(define cell-get-getter-operation
  (lambda (c) (vector-ref c 1)))
(define cell-get-setter-operation
  (lambda (c) (vector-ref c 2)))

(define cell?
  (lambda (c)
    ((cell-get-predicate-operation c))))
(define contents
  (lambda (c)
    ((cell-get-getter-operation c))))
(define setcell
  (lambda (i c)
    ((cell-get-setter-operation c) i)))

で試験が以下となります。

(use gauche.test)

(add-load-path ".")
(load "cell")

(test-start "cell")
(test-section "cell")
(test* "(cell 0 1)"
       #t
       (vector? (cell 0 1)))

(test* "((vector-ref (cell 0 1) 0))"
       #t
       ((vector-ref (cell 0 1) 0)))

(test* "((vector-ref (cell 0 1) 1))"
       1
       ((vector-ref (cell 0 1) 1)))

(let ((c (cell 0 1)))
  (let ((c-r ((vector-ref c 2) 3)))
    (test* "((vector-ref c 1))"
	   3
	   ((vector-ref c 1)))))

(test-section "test cell-get")
(let ((c (cell 0 1)))
  (test* "((cell-get-predicate-operation c))"
	 #t
	 ((cell-get-predicate-operation c)))
  (test* "((cell-get-getter-operation c))"
	 1
	 ((cell-get-getter-operation c)))
  ((cell-get-setter-operation c) 3)
  (test* "((cell-get-getter-operation c))"
	 3
	 ((cell-get-getter-operation c)))
  )

(test-section "test i/f")
(let ((c (cell 0 1)))
  (test* "(cell? c)"
	 #t
	 (cell? c))
  (test* "(contents c)"
	 1
	 (contents c))
  (setcell 2 c)
  (test* "(contents c)"
	 2
	 (contents c))
  )

(test-end)

中の手続きと公開されてる手続きの名前がカブッてますが、そのあたりはご容赦下さい。