From 1fdb733d0cec089ef5de9be3e6fd2800ee97a5eb Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Sat, 24 Apr 2021 10:28:37 -0400
Subject: [PATCH] Implement 5.43 making it a little harder for myself

---
 ex-5_39-xx.scm                            | 54 +++++++++++++++++++----
 misc/sicp-compiler-lexical-addressing.scm | 12 ++---
 2 files changed, 52 insertions(+), 14 deletions(-)

diff --git a/ex-5_39-xx.scm b/ex-5_39-xx.scm
index 47ad64d..565be0e 100644
--- a/ex-5_39-xx.scm
+++ b/ex-5_39-xx.scm
@@ -121,16 +121,52 @@
 (display "[done]\n")
 
 
-(display "\nex-5.43 - scan-out-defines\n")
+(display "\nex-5.43 - defines-to-let\n")
 
-; Exercise 5.43.  We argued in section 4.1.6 that internal definitions for
-; block structure should not be considered ``real'' defines. Rather, a
-; procedure body should be interpreted as if the internal variables being
-; defined were installed as ordinary lambda variables initialized to their
-; correct values using set!. Section 4.1.6 and exercise 4.16 showed how to
-; modify the metacircular interpreter to accomplish this by scanning out
-; internal definitions. Modify the compiler to perform the same transformation
-; before it compiles a procedure body.
+(define (contains-defines? body)
+  (cond
+    ((null? body) #f)
+    ((definition? (car body)) #t)
+    (else (contains-defines? (cdr body)))))
+
+(define (defines-to-let body)
+  (define (get-defines body)
+    (cond
+      ((null? body) '())
+      ((definition? (car body)) (cons (car body) (get-defines (cdr body))))
+      (else (get-defines (cdr body)))))
+  (define (expression->new-expression exp)
+    (if (definition? exp)
+      (define->set exp)
+      exp))
+  (define (define->let-assignment def)
+    (list (definition-variable def) '*unassigned*))
+  (define (define->set def)
+    (list 'set! (definition-variable def) (definition-value def)))
+  (let* ((defines (get-defines body))
+         (let-assignments (map define->let-assignment defines))
+         (let-expression (list 'let let-assignments))
+         (expressions (map expression->new-expression body)))
+    (append let-expression expressions)))
+
+(define (lambda->lambda-without-defines exp)
+  (if (contains-defines? (lambda-body exp))
+    (make-lambda
+      (lambda-parameters exp)
+      (list (defines-to-let (lambda-body exp))))
+    exp))
+
+(compile-to-file
+  '(lambda (x y)
+     (define z 5)
+     (+ x y z))
+  'val 'next "f-def-to-var.scm")
+
+(display "[done]\n")
 
 (display "\nex-5.44\n")
 
+
+(display "\nex-5.45\n")
+
+
diff --git a/misc/sicp-compiler-lexical-addressing.scm b/misc/sicp-compiler-lexical-addressing.scm
index 0cf494e..bce0626 100644
--- a/misc/sicp-compiler-lexical-addressing.scm
+++ b/misc/sicp-compiler-lexical-addressing.scm
@@ -29,8 +29,7 @@
         ((definition? exp)
          (compile-definition exp ct-env target linkage))
         ((if? exp) (compile-if exp ct-env target linkage))
-        ((let? exp)
-          (compile (let->combination exp) ct-env target linkage))
+        ((let? exp) (compile (let->combination exp) ct-env target linkage))
         ((lambda? exp) (compile-lambda exp ct-env target linkage))
         ((begin? exp)
          (compile-sequence (begin-actions exp)
@@ -52,9 +51,12 @@
 (define (empty-instruction-sequence)
   (make-instruction-sequence '() '() '()))
 
-;; Implemented in 5.38.
+;; Implemented in 5.38
 (define (primitive-procedure? exp) #f)
 
+;; Implemented in 5.43
+(define (lambda->lambda-without-defines exp) exp)
+
 ;;;SECTION 5.5.2
 
 ;;;linkage code
@@ -187,8 +189,8 @@
 (define (compile-lambda exp ct-env target linkage)
   (let ((proc-entry (make-label 'entry))
         (after-lambda (make-label 'after-lambda)))
-    (let ((lambda-linkage
-           (if (eq? linkage 'next) after-lambda linkage)))
+    (let ((lambda-linkage (if (eq? linkage 'next) after-lambda linkage))
+          (exp (lambda->lambda-without-defines exp)))
       (append-instruction-sequences
        (tack-on-instruction-sequence
         (end-with-linkage lambda-linkage