diff --git a/scheme/week10/ex3_3.scm b/scheme/week10/ex3_3.scm new file mode 100644 index 0000000..5ac4202 --- /dev/null +++ b/scheme/week10/ex3_3.scm @@ -0,0 +1,34 @@ +;; SICP 3.3 + +;; Exercise 3.3. Modify the make-account procedure so that it creates +;; password-protected accounts. That is, make-account should take a +;; symbol as an additional argument, as in + +;; (define acc (make-account 100 'secret-password)) + +;; The resulting account object should process a request only if it is +;; accompanied by the password with which the account was created, and +;; should otherwise return a complaint: + +;; ((acc 'secret-password 'withdraw) 40) +;; 60 + +;; ((acc 'some-other-password 'deposit) 50) +;; "Incorrect password" + +;; ------------------------------------------------------------------- + +(define (make-account actual-password balance) + (define (withdraw amount) + (cond ((> amount balance) "Insufficient funds") + (else (set! balance (- balance amount)) + balance))) + (define (deposit amount) + (set! balance (+ balance amount)) + balance) + (define (bad-password ignored) + "Incorrect password") + (lambda (password operation) + (cond ((not (equal? password actual-password)) bad-password) + ((equal? operation 'withdraw) withdraw) + ((equal? operation 'deposit) deposit)))) diff --git a/scheme/week10/ex3_3_test.scm b/scheme/week10/ex3_3_test.scm new file mode 100644 index 0000000..4214055 --- /dev/null +++ b/scheme/week10/ex3_3_test.scm @@ -0,0 +1,28 @@ +;; SICP Tests 3.3 + +(test-case "Ex 3.3 -- make-account creates an account" + (let ((a (make-account 'pw 10))) + (assert-not-equal () a))) + +(test-case "Ex 3.3 -- withdrawing money from an account" + (let ((acc (make-account 'pw 10))) + (assert-equal 8 ((acc 'pw 'withdraw) 2)))) + +(test-case "Ex 3.3 -- withdrawing all money from an account" + (let ((acc (make-account 'pw 10))) + (assert-equal 0 ((acc 'pw 'withdraw) 10)))) + +(test-case "Ex 3.3 -- overdrawing money from an account" + (let ((acc (make-account 'pw 10))) + (assert-equal "Insufficient funds" ((acc 'pw 'withdraw) 12)))) + +(test-case "Ex 3.3 -- depositing money to an account" + (let ((acc (make-account 'pw 10))) + (assert-equal 17 ((acc 'pw 'deposit) 7)))) + +(test-case "Ex 3.3 -- bad password" + (let ((acc (make-account 'pw 10))) + (assert-equal "Incorrect password" + ((acc 'bad-pw 'deposit) 7)) + (assert-equal "Incorrect password" + ((acc 'bad-pw 'withdraw) 7))))