learning-sicp

commit 3373eff3cf6e1a3c707596e19d76b258a7fb9109
parent eb5a45a7c10e70396d5117be82cb8e032e8f9109
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Thu, 25 Jul 2024 17:18:51 +0300

Fix exercise 4.12. solution.

Diffstat:
M
sicp/solutions/chapter-4/exercise-12.scm
 | 
28
+++++++++++++---------------
M
sicp/tests/chapter-4/exercise-12.scm
 | 
15
++++++++++++---

2 files changed, 25 insertions(+), 18 deletions(-)
diff --git a/sicp/solutions/chapter-4/exercise-12.scm b/sicp/solutions/chapter-4/exercise-12.scm
@@ -425,21 +425,19 @@
       ;;           (loop-over-frame ((cdr vars)
       ;;                             (cdr vals))))))))))
 
-      (define (env-loop env)
-        (define (scan vars vals)
-          (cond ((null? vars)
-                 (env-loop
-                  (enclosing-environment env)))
-                ((eq? var (car vars))
-                 (set-car! vals val))
-                (else (scan (cdr vars)
-                            (cdr vals)))))
-        (if (eq? env the-empty-environment)
-            (error "Unbound variable: SET!" var)
-            (let ((frame (first-frame env)))
-              (scan (frame-variables frame)
-                    (frame-values frame)))))
-      (env-loop env))
+      (dpp `(before set-variable-value! ,var ,val ,env))
+      (let env-loop ((env env))
+        (cond
+         ((eq? env the-empty-environment)
+          (error "Unbound variable: SET!" var))
+         (else
+          (let ((frame (first-frame env)))
+            (match (get-frame-variable-value var frame)
+              (#f
+               (env-loop (enclosing-environment env)))
+              (pair
+               (set-cdr! pair val)))))))
+      (dpp `(after set-variable-value! ,var ,val ,env)))
 
     (define (define-variable! var val env)
       "Add a new variable VAR with value VAL in the top frame of environment ENV.
diff --git a/sicp/tests/chapter-4/exercise-12.scm b/sicp/tests/chapter-4/exercise-12.scm
@@ -15,8 +15,8 @@
     (test-begin "chapter-4-exercise-12")
 
     (test-equal 1
-         (eval '1
-               (setup-environment)))
+      (eval '1
+            (setup-environment)))
 
     (test-equal 1
       (eval '(begin
@@ -51,4 +51,13 @@
                  (+ a b)))
             (setup-environment)))
 
-    (test-end "chapter-4-exercise-12")))
+    (test-equal 5
+      (eval '(begin
+               (define a 1) ;; a = 1
+               (let ((b (+ a 1))) ;; b = 1 + 1 = 2
+                 (set! b (+ b b)) ;; b = b + b = 2 + 2 = 4
+                 (+ a b))) ;; a = a + b = 1 + 4 = 5
+            (setup-environment)))
+
+    (test-end "chapter-4-exercise-12")
+    ))