Implement till 5.39

misc/sicp-compiler-lexical-addressing.scm

@@ -13,31 +13,35 @@
 
 ;;**implementation-dependent loading of syntax procedures
 (load "misc/sicp-syntax.scm")			;section 4.1.2 syntax procedures
+(load "misc/sicp-eceval-support.scm") ;; for let support
 
 
 ;;;SECTION 5.5.1
 
-(define (compile exp target linkage)
+(define (compile exp ct-env target linkage)
   (cond ((self-evaluating? exp)
          (compile-self-evaluating exp target linkage))
         ((quoted? exp) (compile-quoted exp target linkage))
         ((variable? exp)
-         (compile-variable exp target linkage))
+         (compile-variable exp ct-env target linkage))
         ((assignment? exp)
-         (compile-assignment exp target linkage))
+         (compile-assignment exp ct-env target linkage))
         ((definition? exp)
-         (compile-definition exp target linkage))
-        ((if? exp) (compile-if exp target linkage))
-        ((lambda? exp) (compile-lambda exp target linkage))
+         (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))
+        ((lambda? exp) (compile-lambda exp ct-env target linkage))
         ((begin? exp)
          (compile-sequence (begin-actions exp)
+                           ct-env
                            target
                            linkage))
-        ((cond? exp) (compile (cond->if exp) target linkage))
+        ((cond? exp) (compile (cond->if exp) ct-env target linkage))
         ((primitive-procedure? exp)
          (compile-primitive exp target linkage))
         ((application? exp)
-         (compile-application exp target linkage))
+         (compile-application exp ct-env target linkage))
         (else
          (error "Unknown expression type -- COMPILE" exp))))
 
@@ -83,7 +87,7 @@
    (make-instruction-sequence '() (list target)
     `((assign ,target (const ,(text-of-quotation exp)))))))
 
-(define (compile-variable exp target linkage)
+(define (compile-variable exp ct-env target linkage)
   (end-with-linkage linkage
    (make-instruction-sequence '(env) (list target)
     `((assign ,target
@@ -91,7 +95,7 @@
               (const ,exp)
               (reg env))))))
 
-(define (compile-assignment exp target linkage)
+(define (compile-assignment exp ct-env target linkage)
   (let ((var (assignment-variable exp))
         (get-value-code
          (compile (assignment-value exp) 'val 'next)))
@@ -105,10 +109,10 @@
                   (reg env))
          (assign ,target (const ok))))))))
 
-(define (compile-definition exp target linkage)
+(define (compile-definition exp ct-env target linkage)
   (let ((var (definition-variable exp))
         (get-value-code
-         (compile (definition-value exp) 'val 'next)))
+         (compile (definition-value exp) ct-env 'val 'next)))
     (end-with-linkage linkage
      (preserving '(env)
       get-value-code
@@ -135,18 +139,18 @@
                    (number->string (new-label-number)))))
 ;; end of footnote
 
-(define (compile-if exp target linkage)
+(define (compile-if exp ct-env target linkage)
   (let ((t-branch (make-label 'true-branch))
         (f-branch (make-label 'false-branch))
         (after-if (make-label 'after-if)))
     (let ((consequent-linkage
            (if (eq? linkage 'next) after-if linkage)))
-      (let ((p-code (compile (if-predicate exp) 'val 'next))
+      (let ((p-code (compile (if-predicate exp) ct-env 'val 'next))
             (c-code
              (compile
-              (if-consequent exp) target consequent-linkage))
+              (if-consequent exp) ct-env target consequent-linkage))
             (a-code
-             (compile (if-alternative exp) target linkage)))
+             (compile (if-alternative exp) ct-env target linkage)))
         (preserving '(env continue)
          p-code
          (append-instruction-sequences
@@ -160,16 +164,16 @@
 
 ;;; sequences
 
-(define (compile-sequence seq target linkage)
+(define (compile-sequence seq ct-env target linkage)
   (if (last-exp? seq)
-      (compile (first-exp seq) target linkage)
+      (compile (first-exp seq) ct-env target linkage)
       (preserving '(env continue)
-       (compile (first-exp seq) target 'next)
-       (compile-sequence (rest-exps seq) target linkage))))
+       (compile (first-exp seq) ct-env target 'next)
+       (compile-sequence (rest-exps seq) ct-env target linkage))))
 
 ;;;lambda expressions
 
-(define (compile-lambda exp target linkage)
+(define (compile-lambda exp ct-env target linkage)
   (let ((proc-entry (make-label 'entry))
         (after-lambda (make-label 'after-lambda)))
     (let ((lambda-linkage
@@ -182,11 +186,12 @@
                     (op make-compiled-procedure)
                     (label ,proc-entry)
                     (reg env)))))
-        (compile-lambda-body exp proc-entry))
+        (compile-lambda-body exp ct-env proc-entry))
        after-lambda))))
 
-(define (compile-lambda-body exp proc-entry)
-  (let ((formals (lambda-parameters exp)))
+(define (compile-lambda-body exp ct-env proc-entry)
+  (let* ((formals (lambda-parameters exp))
+         (ct-env (extend-compile-time-env formals ct-env)))
     (append-instruction-sequences
      (make-instruction-sequence '(env proc argl) '(env)
       `(,proc-entry
@@ -196,17 +201,17 @@
                 (const ,formals)
                 (reg argl)
                 (reg env))))
-     (compile-sequence (lambda-body exp) 'val 'return))))
+     (compile-sequence (lambda-body exp) ct-env 'val 'return))))
 
 
 ;;;SECTION 5.5.3
 
 ;;;combinations
 
-(define (compile-application exp target linkage)
-  (let ((proc-code (compile (operator exp) 'proc 'next))
+(define (compile-application exp ct-env target linkage)
+  (let ((proc-code (compile (operator exp) ct-env 'proc 'next))
         (operand-codes
-         (map (lambda (operand) (compile operand 'val 'next))
+         (map (lambda (operand) (compile operand ct-env 'val 'next))
               (operands exp))))
     (preserving '(env continue)
      proc-code