SICP問題3.7
3.3で定義したパスワードつきのmake-accountの定義。passwordが同じ時だけmake-jointで共同口座を作れるようにパスワードが正しいかチェックする振る舞いを追加。
(define (make-account balance password) (define (withdraw amount) (if (>= balance amount) (begin (set! balance (- balance amount)) balance) "Insufficient funds")) (define (deposit amount) (set! balance (+ balance amount)) balance) (define (correct-password? input-password) (eq? input-password password)) (define (dispatch p m) (if (correct-password? p) (cond ((eq? m 'withdraw) withdraw) ((eq? m 'deposit) deposit) ((eq? m 'can-joint?) #t) (else (error "Unknown request -- MAKE-ACCOUNT" p m))) ; 修正 (if (eq? m 'can-joint?) #f (error "Incorrect password" p m)))) dispatch)
make-jointの定義
(define (make-joint source-account source-password dist-password) (define (correct-password? input-password) (eq? input-password dist-password)) (define (dispatch p m) (if (correct-password? p) (cond ((eq? m 'withdraw) (source-account source-password 'withdraw)) ((eq? m 'deposit) (source-account source-password 'desposit)) (else (error "Unknown request -- MAKE-ACCOUNT" p m))) (error "Incorrect password" p))) (if (source-account source-password 'can-joint?) dispatch (error "Incorrect Source Password" source-password)))
テスト
(define peter-acc (make-account 100 'open-sesami)) ; peter-acc (define paul-acc (make-joint peter-acc 'open-sesami 'rosebud)) ; paul-acc ((peter-acc 'open-sesami 'withdraw) 10) ; 90 ((paul-acc 'rosebud 'withdraw) 10) ; 80 ((paul-acc 'rosebudd 'withdraw) 10) ; *** ERROR: Incorrect password rosebudd ; Stack Trace: ; _______________________________________ ; 0 (paul-acc 'rosebudd 'withdraw) ; At line 22 of "(stdin)" (define paul-acc-2 (make-joint peter-acc 'open-sesami2 'rosebud)) ; *** ERROR: Incorrect Source Password open-sesami2 ; Stack Trace: ; _______________________________________ ; 0 (make-joint peter-acc 'open-sesami2 'rosebud) ; At line 28 of "(stdin)"