EoPL reading (105) 2.3 Representation Strategies for Data Types

Exercise 2.15

stack は手続きオブジェクトなんだけど操作の数が多いし云々、と頭を痛めつつ移動中の車の中で実装に思い至る。調子が良いトキって端末の前じゃない方が良いひらめきがあるのかどうなのか。
# そもそも調子が良いのかどうかも不明ですが (何
で、テストファーストで、って思ってたんですが、実装が先にでっち上がってしまったので順番逆ですが、実装が以下。

(define eopl:error error)

(define empty-stack
  (lambda ()
    (lambda (cmd)
      (cond ((eqv? cmd 'empty?) #t)
	    ((or (eqv? cmd 'pop)
		 (eqv? cmd 'top))
	     (eopl:error 'empty-stack
			 "stack is empty ~s" cmd))
	    (else
	     (eopl:error 'empty-stack
			 "Invalid cmd ~s" cmd))))))

(define empty-stack?
  (lambda (stack)
    (stack 'empty?)))
(define pop
  (lambda (stack)
    (stack 'pop)))
(define top
  (lambda (stack)
    (stack 'top)))

(define push
  (lambda (val stack)
    (lambda (cmd)
      (cond ((eqv? cmd 'pop) stack)
	    ((eqv? cmd 'top) val)
	    ((eqv? cmd 'empty?) #f)
	    (else
	     (eopl:error 'push
			 "Invalid cmd ~s" cmd))))))

メッセージパッシング方式 (本当かなぁ)。
スタックなオブジェクトは一引数を受け取る手続きオブジェクト、という事にしてしまう。でもそうだとすると 2.14 の問題の解としてはコンストラクタは push と empty-stack のみ、ってコトになるな。いやはや。
で、後付けな試験が以下となります。

(use gauche.test)

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

(test-start "stack")
(test-section "empty-stack")
(test* "pop from empty-stack"
       *test-error*
       ((empty-stack) 'pop))
(test* "top from empty-stack"
       *test-error*
       ((empty-stack) 'top))
(test* "invalid command"
       *test-error*
       ((empty-stack) 'a))
(test* "empty-stack is empty"
       #t
       ((empty-stack) 'empty?))

(test-section "empty-stack?")
(test* "(empty-stack? (empty-stack)) returns true"
       #t
       (empty-stack? (empty-stack)))
(test* "(empty-stack? (push 1 (empty-stack))) return false"
       #f
       (empty-stack? (push 1 (empty-stack))))

(test-section "pop")
(test* "pop from empty-stack"
       *test-error*
       (pop (empty-stack)))
(test* "empty-stack"
       #t
       (empty-stack? (pop (push 1 (empty-stack)))))

(test-section "top")
(test* "top from empty-stack"
       *test-error*
       (top (empty-stack)))
(test* "top from non-empty-stack"
       1
       (top (push 1 (empty-stack))))

(test-section "push")
(let ((s (push 1 (push 2 (empty-stack)))))
  (test* "top value is 1"
	 1
	 (top s))
  (test* "top value is 2 (pop after)"
	 2
	 (top (pop s)))
  (test* "pop from empty-stack"
	 *test-error*
	 (top (pop (pop s))))
  )

(test-end)

なんとなくカバーしきれてない気もするんですが、こんなものかな、と。