SICP 読み (98) 3.1.3 代入を取り入れた代価

scheme 脳が退化。短いソレでも簡単に退化してしまうあたり、微妙スギ。

問題 3.7

昨晩、着手しかけたんですが酔っぱらってしまい断念。再度検討着手。とりあえず以下のような形で、というのを前提にしてみる。

例示されているナニは以下で paul-acc を make-joint の戻りで束縛。

(define paul-acc
  (make-joint peter-acc 'open-sesame 'rosebud))

paul-acc を使って口座から引き落しなソレは以下。

((paul-acc 'rosebud 'widthdraw) 50)
50

という事は正常系なソレは make-joint が戻せば良いのは上記のソレは以下のナニに置き換えられれば良い、と類推。

((peter-acc 'open-sesame 'widthdraw) 50)

で、試験を書いて実装もしてみたんですが、試験が動かん。面倒なので現時点での実装を以下にサラす。ツカレてるんで乱暴モノです。(何

(define (make-join acc p1 p2)
  (let ((account acc)
	(pass1 p1)
	(pass2 p2))
    (if (account pass1 'pass)
	(lambda (p m)
	  (if (eq? p pass2)
	      (account pass1 m)
	      (error "Incorrect password -- MAKE-ACCOUNT"
		     pass2)))
	(error "Incorrect password -- MAKE-ACCOUNT"
	       pass1))
      )
  )

(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 (pass p)
    (eq? p password))

  (define (dispatch p m)
    (let ((c (pass p)))
      (if (eq? m 'pass)
	  c
	  (if c
	      (cond ((eq? m 'widthdraw) widthdraw)
		    ((eq? m 'deposit) deposit)
		    (else
		     (error "Unkown request -- MAKE-ACCOUNT"
			    m)))
	      (error "Incorrect password -- MAKE-ACCOUNT"
		     p)))))
  dispatch)

なんか微妙。それにしても試験が何故に動かんのだ。もう少し冷静に調べてみる必要があるのは分かってるんですが、割り込み多くって余裕ナシ。

問題 3.8

これも試験は困難なんで試験略。(を

全然検証してない (こともない) んですが、こんな感じになるのかなぁ。(謎

(define f
  (let ((c '()))
    (define (f-update x)
      (if (null? c)
	  (set! c x)
	  c))

    (lambda (n)
      (set! c (f-update n)))))

ってもの凄いハマった。ちなみに参考にしたのは p.132 の rand 手続きです。微妙。

追記

試験ですが、ファイル名誤りでした。test-3.7.scm みたいな形でないといけないのに、test.3.7.scm となっており、スルーされていた模様。一応試験を以下に。

#!/usr/bin/env gosh

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

(define-test-suite "3.7"
 ("3.3"
  ("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.7"
  ("p.137"
   (let ((peter-acc (make-account 100 'open-sesame)))
     (let ((paul-acc (make-joint peter-acc 'open-sesame 'rosebud)))
       (assert-equal 50 ((paul-acc 'rosebud 'widthdraw) 50))))
   )

  ("password invalid"
   (let ((peter-acc (make-account 100 'open-sesame)))
     (assert-error (lambda () (make-joint peter-acc 'xxx 'rosebud))))
   )

  ("password invalid (2)"
   (let ((peter-acc (make-account 100 'open-sesame)))
     (let ((paul-acc (make-joint peter-acc 'open-sesame 'rosebud)))
       (assert-error (lambda () ((paul-acc 'xxx 'widthdraw) 50)))))
   )
  )
 )

うーん ...