learning-sicp

commit de7c5637fe29f4e518258215546adc1a9f8bd83a
parent 618243f3286dcddfe2ba50d472a581c9e113ad56
Author: Yuval Langer <yuval.langer@gmail.com>
Date:   Sat,  3 Aug 2024 21:28:26 +0300

Add solution to exercise 4.14.  Also, get right line number in the debug print macros.

Diffstat:
M
sicp/solutions/chapter-4/exercise-14.scm
 | 
36
++++++++++++++++++++++++------------
M
sicp/tests/chapter-4/exercise-14.scm
 | 
13
+++++++++++++
M
sicp/utils.scm
 | 
4
++--

3 files changed, 39 insertions(+), 14 deletions(-)
diff --git a/sicp/solutions/chapter-4/exercise-14.scm b/sicp/solutions/chapter-4/exercise-14.scm
@@ -99,7 +99,8 @@
                (loop rest))))))
 
     (define (eval exp env)
-      (dpp (list exp env))
+      (dp exp)
+      (dp env)
       (let ((value (cond ((self-evaluating? exp)
                           exp)
                          ((variable? exp)
@@ -108,7 +109,7 @@
                           ((get-form-handler exp) exp env))
                          (else
                           (error "Unknown expression type -- EVAL" exp)))))
-        (dpp `(eval value: ,value))
+        (dp `(eval value: ,value))
         value))
 
     (define (apply procedure arguments)
@@ -381,6 +382,8 @@
                    val))))
 
     (define (extend-environment vars vals base-env)
+      (dp vars)
+      (dp vals)
       (if (= (length vars) (length vals))
           (cons (make-frame vars vals) base-env)
           (if (< (length vars) (length vals))
@@ -392,7 +395,7 @@
                      vals))))
 
     (define (lookup-variable-value var env)
-      (dpp `(,var ,env))
+      (dp `(,var ,env))
       (define (env-loop env)
         (if (eq? env the-empty-environment)
             (error "Unbound variable -- LOOKUP-VARIABLE-VALUE" var)
@@ -425,7 +428,7 @@
       ;;           (loop-over-frame ((cdr vars)
       ;;                             (cdr vals))))))))))
 
-      (dpp `(before set-variable-value! ,var ,val ,env))
+      (dp `(before set-variable-value! ,var ,val ,env))
       (let env-loop ((env env))
         (cond
          ((eq? env the-empty-environment)
@@ -437,7 +440,7 @@
                (env-loop (enclosing-environment env)))
               (pair
                (set-cdr! pair val)))))))
-      (dpp `(after set-variable-value! ,var ,val ,env)))
+      (dp `(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.
@@ -475,7 +478,7 @@ frame to VAL."
                (else (make-unbound! var
                                     (enclosing-environment env)))))
              ((eq? (car frame-alist)
-                     var)
+                   var)
               (loop (cdr frame-alist)
                     new-frame
                     #t))
@@ -502,16 +505,17 @@ frame to VAL."
                     (list '= =)
                     (list 'display display)
                     (list 'write write)
-                    (list 'read read)))
+                    (list 'read read)
+                    (list 'list list)))
              (initial-env
               (extend-environment
                (primitive-procedure-names primitive-procedures)
                (primitive-procedure-objects primitive-procedures)
                the-empty-environment)))
-        (dpp initial-env)
+        (dp initial-env)
         (define-variable! 'true true initial-env)
         (define-variable! 'false false initial-env)
-        (dpp initial-env)
+        (dp initial-env)
         initial-env))
 
     (define the-global-environment
@@ -537,7 +541,8 @@ frame to VAL."
              (list '/ /)
              (list 'display display)
              (list 'write write)
-             (list 'read read)))
+             (list 'read read)
+             (list '*debug* *debug* )))
 
     (define (primitive-procedure-names primitive-procedures)
       (map car
@@ -685,5 +690,12 @@ frame to VAL."
     (add-form-handler! (lambda (exp) (tagged-list? exp 'let*))
                        (lambda (exp env)
                          (eval (let*->nested-lets exp) env)))
-
-    ))
+    (add-form-handler! (lambda (exp) (tagged-list? exp 'map-form))
+                       (lambda (exp env)
+                         (let* ((f (eval (cadr exp) env))
+                                (our-list (eval (caddr exp) env))
+                                (_ (dp our-list))
+                                (result (map (lambda (x)
+                                               (apply f (list x)))
+                                             our-list)))
+                           result)))))
diff --git a/sicp/tests/chapter-4/exercise-14.scm b/sicp/tests/chapter-4/exercise-14.scm
@@ -53,6 +53,19 @@
                          '(0 1 2))))
             (setup-environment)))
 
+    (test-equal '()
+      (eval '(map-form (lambda (x) (+ x 2)) '())
+            (setup-environment)))
+
+    (test-equal '(3 4 5)
+      (eval '(map-form (lambda (x) (+ x 2)) (list 1 2 3))
+            (setup-environment)))
+
+    (test-equal '(3 4 5)
+      (eval '(let ((l (list 1 2 3)))
+               (map-form (lambda (x) (+ x 2)) l))
+            (setup-environment)))
+
     (test-equal 1
       (eval '1
             (setup-environment)))
diff --git a/sicp/utils.scm b/sicp/utils.scm
@@ -43,7 +43,7 @@
                (line-number (cdr (assoc 'line loc eq?)))
                (column-number (cdr (assoc 'column loc eq?)))
                (x-val x))
-          (display line-number)
+          (display (+ line-number 1))
           (display ":")
           (display column-number)
           (display ":")
@@ -63,7 +63,7 @@
                (line-number (cdr (assoc 'line loc eq?)))
                (column-number (cdr (assoc 'column loc eq?)))
                (x-val x))
-          (display line-number)
+          (display (+ line-number 1))
           (display ":")
           (display column-number)
           (display ":")