From f2cd087e04236a000e8404ccbff8e42fa2396949 Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Sun, 24 Jan 2021 11:12:40 -0500
Subject: [PATCH] Implement till 4.21

---
 ex-4_11-xx.scm | 115 +++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 112 insertions(+), 3 deletions(-)

diff --git a/ex-4_11-xx.scm b/ex-4_11-xx.scm
index 2e4ccc5..2457505 100644
--- a/ex-4_11-xx.scm
+++ b/ex-4_11-xx.scm
@@ -244,7 +244,7 @@
 (define (make-procedure parameters body env)
   (list 'procedure parameters (scan-out-defines body) env))
 
-(display "\nex-4.17\n")
+(display "\nex-4.17 - extra-frame\n")
 
 ; Why is there an extra frame in the transformed program? We have implemented
 ; let via an additional transformation. Therefore, there is another
@@ -292,7 +292,116 @@
 
 (display "[answered]\n")
 
-(display "\nex-4.19\n")
+(display "\nex-4.19 - ambiguous-expression\n")
 
-; (display "\nex-4.20\n")
+; (let ((a 1))
+;   (define (f x)
+;     (define b (+ a x))
+;     (define a 5)
+;     (+ a b))
+;   (f 10))
 
+; Ben: 16
+; Alyssa: error
+; Eva: 20
+
+; To implement Eva's suggested behavior one could reorder the defines so that
+; defines with self-evaluating expressions are interpreted first.
+
+(display "[answered]\n")
+
+(display "\nex-4.20 - letrec\n")
+
+(letrec ((fact
+          (lambda (n)
+            (if (= n 1)
+                1
+                (* n (fact (- n 1)))))))
+  (assert (fact 10) 3628800))
+
+(define letrec-before
+  '(letrec ((a 3) (b 2))
+     (+ a b)))
+
+(define letrec-after
+  '(let ((a *unassigned*) (b *unassigned*))
+     (set! a 3)
+     (set! b 2)
+     (+ a b)))
+
+(define (letrec? exp) (tagged-list exp 'letrec))
+(define (letrec-bindings exp) (cadr exp))
+(define (letrec-body exp) (cddr exp))
+(define (letrec-binding-var binding) (car binding))
+(define (letrec-binding-exp binding) (cadr binding))
+(define (letrec-vars exp) (map let-binding-var (let-bindings exp)))
+(define (letrec-exps exp) (map let-binding-exp (let-bindings exp)))
+
+(define (letrec->combination exp)
+  (define (binding->unassigned binding)
+    (list (letrec-binding-var binding) '*unassigned*))
+  (define (binding->set binding)
+    (list 'set! (letrec-binding-var binding) (letrec-binding-exp binding)))
+  (let* ((bindings (letrec-bindings exp))
+         (bindings-unassigned (map binding->unassigned bindings))
+         (let-unassigned (list 'let bindings-unassigned))
+         (set-exps (map binding->set bindings))
+         (body (letrec-body exp)))
+    (append
+      (append let-unassigned set-exps)
+      body)))
+
+(assert (letrec->combination letrec-before) letrec-after)
+
+; b. With the let implementation the procedures odd? and even? cannot see and
+; therefore not call each other.
+
+(display "\nex-4.21 - recursive-without-define/letrec\n")
+
+; factorial
+(assert
+((lambda (n)
+   ((lambda (fact)
+      (fact fact n))
+    (lambda (ft k)
+      (if (= k 1)
+          1
+          (* k (ft ft (- k 1)))))))
+ 10)
+3628800)
+
+; a. Fibonacci
+(define (fibo n)
+  (cond
+    ((= n 0) 0)
+    ((< n 3) 1)
+    (else (+ (fibo (- n 2)) (fibo (- n 1))))))
+
+(assert
+((lambda (n)
+   ((lambda (fib)
+      (fib fib n))
+    (lambda (f k)
+      (cond
+        ((= k 0) 0)
+        ((< k 3) 1)
+        (else (+ (f f (- k 2)) (f f (- k 1))))))))
+ 11)
+(fibo 11))
+
+; b. odd?/even?
+(define (f x)
+  ((lambda (even? odd?)
+     (even? even? odd? x))
+   (lambda (ev? od? n)
+     (if (= n 0) true (od? ev? od? (- n 1))))
+   (lambda (ev? od? n)
+     (if (= n 0) false (ev? ev? od? (- n 1))))))
+
+(assert (f 31) false)
+(assert (f 42) true)
+
+(display "\nex-4.22\n")
+
+; (display "\nex-4.23\n")
+; (display "\nex-4.24\n")