learning-sicp

commit 1af37461d13be37dcb9232cd3dc448f65a8a3d99
parent 2d18dbc20b1e1a9099397209c5c67daa6304b508
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Sun,  2 Apr 2023 16:46:37 +0300

Add more solutions.

Diffstat:
A
sicp/solutions/3_4.scm
 | 
38
++++++++++++++++++++++++++++++++++++++
A
sicp/tests/3_4.scm
 | 
38
++++++++++++++++++++++++++++++++++++++

2 files changed, 76 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/3_4.scm b/sicp/solutions/3_4.scm
@@ -0,0 +1,38 @@
+(define-library (sicp solutions 3_4)
+  (import (scheme base))
+  (export make-account)
+
+  (begin
+    (define (call-to-cops)
+      "Cops called.")
+
+    (define (make-account balance super-secret-symbol)
+      (define number-of-failed-authentication-attempts 0)
+      
+      (define (withdraw amount)
+        (if (>= balance amount)
+            (begin
+              (set! balance
+                    (- balance
+                       amount))
+              balance)
+            "Insufficient funds"))
+
+      (define (deposit amount)
+        (set! balance (+ balance
+                         amount))
+        balance)
+
+      (lambda (whisper m)
+        (if (eq? whisper super-secret-symbol)
+            (cond
+             ((eq? m 'withdraw) withdraw)
+             ((eq? m 'deposit) deposit)
+             (else (error "Uknown request: MAKE-ACCOUNT" m)))
+            (lambda x
+              (begin
+                (set! number-of-failed-authentication-attempts
+                      (+ 1 number-of-failed-authentication-attempts))
+                (if (<= 7 number-of-failed-authentication-attempts)
+                    (call-to-cops)
+                    "Incorrect password"))))))))
diff --git a/sicp/tests/3_4.scm b/sicp/tests/3_4.scm
@@ -0,0 +1,38 @@
+(import (srfi :64))
+(import (sicp solutions 3_4))
+
+(define acc
+  (make-account 100 'secret-password))
+
+(test-begin "3.4")
+(test-equal
+    60
+  ((acc 'secret-password 'withdraw) 40))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+    "Incorrect password"
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+"Cops called."
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+"Cops called."
+  ((acc 'some-other-password 'deposit) 50))
+(test-equal
+"Cops called."
+  ((acc 'some-other-password 'deposit) 50))
+(test-end "3.4")