SICP 読み (97) 3.1.1 局所状態変数

問題 3.2 の試験は reset-count な試験を略しているんですが、スルーで。
問題 3.3

修正する make-account は p.130 のもので良いのかな。例示されている実行例を元に、以下の試験を書いてみた。

#!/usr/bin/env gosh

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

(define-test-suite "3.3"
  ("sample"
   ("p.130"
    (let ((acc (make-account 100)))
      (assert-equal 50 ((acc 'widthdraw) 50))
      (assert-equal "Insufficient funds"
		    ((acc 'widthdraw) 60))
      (assert-equal 90 ((acc 'deposit) 40))
      (assert-equal 30 ((acc 'widthdraw) 60)))
    )
   )
  )

当たり前ですが試験はパス。error になるケースが無いがとりあえずスルー。で、パスワードの追加なんですが、dispatch の中で判断ですか。という事は上記の試験は以下のようになるんかな。

#!/usr/bin/env gosh

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

(define-test-suite "3.3"
  ("sample"
   ("p.130"
    (let ((acc (make-account 100 'secret-password)))
      (assert-equal 50 ((acc 'secret-password 'widthdraw) 50))
      (assert-equal "Incorrect password"
		    ((acc 'some-other-password 'widthdraw) 50))
      (assert-equal "Insufficient funds"
		    ((acc 'secret-password 'widthdraw) 60))
      (assert-equal 90 ((acc 'secret-password 'deposit) 40))
      (assert-equal "Incorrect password"
		    ((acc 'some-other-password 'deposit) 50))
      (assert-equal 30 ((acc 'secret-password 'widthdraw) 60)))
    )
   )
  )

以下にとりあえずの実装を。

(define (make-account balance password)
  (define (widthdraw amount)
    (if (>= balance amount)
	(begin (set! balance (- balance amount))
	       balance)
	"Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch p m)
    (if (eq? p password)
	(cond ((eq? m 'widthdraw) widthdraw)
	      ((eq? m 'deposit) deposit)
	      (else
	       (error "Unkown request -- MAKE-ACCOUNT"
		      m)))
	(error "Incorrect password -- MAKE-ACCOUNT"
	       p)))
  dispatch)

で、試験したらオコられた。assert-error 使わんとイケんかったよ。修正後の試験が以下。

#!/usr/bin/env gosh

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

(define-test-suite "3.3"
  ("sample"
   ("p.130"
    (let ((acc (make-account 100 'secret-password)))
      (assert-equal 50 ((acc 'secret-password 'widthdraw) 50))
      (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
      (assert-equal "Insufficient funds"
		    ((acc 'secret-password 'widthdraw) 60))
      (assert-equal 90 ((acc 'secret-password 'deposit) 40))
      (assert-error (lambda () ((acc 'some-other-password 'deposit) 50)))
      (assert-equal 30 ((acc 'secret-password 'widthdraw) 60)))
    )
   )
  )

なんか書いているコトが冗長だな。(恥

問題 3.4

どんどん進めます。この問題の要求しているソレをカバーするには make-account の先頭で (let ((c 0)) とかしておけば良いのかなぁ。問題 3.2 な解はこの方法を使っている。
で、試験は若干微妙ですが、以下な感じ。

 ("excersize 3.4"
  ("call-the-cops"
   (let ((acc (make-account 100 'secret-password)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-error (lambda () ((acc 'some-other-password 'widthdraw) 50)))
     (assert-equal "call-the-cops"
                   ((acc 'some-other-password 'widthdraw) 50))
     )
   )
  )

実装は以下ですが微妙。

(define (make-account balance password)
  (let ((c 0))
    (define (widthdraw amount)
      (if (>= balance amount)
	  (begin (set! balance (- balance amount))
		 balance)
	  "Insufficient funds"))
    (define (deposit amount)
      (set! balance (+ balance amount))
      balance)
    (define (call-the-cops amount)
      "call-the-cops")
    (define (dispatch p m)
      (if (eq? p password)
	  (cond ((eq? m 'widthdraw) widthdraw)
		((eq? m 'deposit) deposit)
		(else
		 (error "Unkown request -- MAKE-ACCOUNT"
			m)))
	  (if (> c 5)
	      call-the-cops
	      (begin (set! c (+ c 1))
		     (error "Incorrect password -- MAKE-ACCOUNT"
			    p)))))
    dispatch))

すげぇヤッツケ感満点ッス。(を