Step 5: Local Variables

1 files changed, 77 insertions, 36 deletions

diff --git a/compiler.scm b/compiler.scm
index 2e34ad2..3baf0e5 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -16,10 +16,6 @@
 (define boolean-tag 31)
 (define empty-list 47) ;; #b00101111
 
-(define (emit template-string . args)
-  (apply format #t template-string args)
-  (newline))
-
 (define (immediate-rep x)
     (cond
      ((integer? x)
@@ -37,6 +33,13 @@
       (boolean? x)
       (null? x)))
 
+(define (variable? x)
+  (symbol? x))
+
+(define (let? x)
+  (and (pair? x)
+       (eq? (first x) 'let)))
+
 (define (primcall? x)
   (and (pair? x)
        (memq (first x)
@@ -62,8 +65,26 @@
 (define (primcall-operand2 x)
   (third x))
 
-(define (emit-tag-check x mask tag si)
-  (emit-expr x si)
+(define (lookup name env)
+  (or (assq-ref env name)
+      (error "unbound variable:" name)))
+
+(define (extend-env name si env)
+  (cons (cons name si) env))
+
+(define (bindings x)
+  (second x))
+
+(define (body x)
+  (third x))
+
+(define (emit template-string . args)
+  (display "        ")
+  (apply format #t template-string args)
+  (newline))
+
+(define (emit-tag-check x mask tag si env)
+  (emit-expr x si env)
   (emit "and $~a, %rax" mask)
   (emit "cmp $~a, %rax" tag)
   (emit "mov $0, %rax")
@@ -71,33 +92,33 @@
   (emit "sal $~a, %rax" boolean-shift)
   (emit "or $~a, %rax" boolean-tag))
 
-(define (emit-comparison x y instruction si)
-  (emit-expr y si)
+(define (emit-comparison x y instruction si env)
+  (emit-expr y si env)
   (emit "mov %rax, ~a(%rsp)" si)
-  (emit-expr x (- si wordsize))
+  (emit-expr x (- si wordsize) env)
   (emit "cmp ~a(%rsp), %rax" si)
   (emit "mov $0, %rax")
   (emit "~a %al" instruction)
   (emit "sal $~a, %rax" boolean-shift)
   (emit "or $~a, %rax" boolean-tag))
 
-(define (emit-primitive-call x si)
+(define (emit-primitive-call x si env)
   (case (primcall-op x)
     ((add1)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      (emit "add $~a, %rax" (immediate-rep 1)))
     ((sub1)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      (emit "sub $~a, %rax" (immediate-rep 1)))
     ((integer->char)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      (emit "sal $~a, %rax" (- char-shift fixnum-shift))
      (emit "or $~a, %rax" char-tag))
     ((char->integer)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      (emit "shr $~a, %rax" (- char-shift fixnum-shift)))
     ((zero?)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      ;; Since the tag of fixnums is 0, we can skip an 'andl'
      ;; instruction that would apply the mask to the immediate
      ;; value.
@@ -107,66 +128,84 @@
      (emit "sal $~a, %rax" boolean-shift)
      (emit "or $~a, %rax" boolean-tag))
     ((null?)
-     (emit-expr (primcall-operand1 x) si)
+     (emit-expr (primcall-operand1 x) si env)
      (emit "cmp $~a, %rax" empty-list)
      (emit "mov $0, %rax")
      (emit "sete %al")
      (emit "sal $~a, %rax" boolean-shift)
      (emit "or $~a, %rax" boolean-tag))
     ((integer?)
-     (emit-tag-check (primcall-operand1 x) fixnum-mask fixnum-tag si))
+     (emit-tag-check (primcall-operand1 x) fixnum-mask fixnum-tag si env))
     ((char?)
-     (emit-tag-check (primcall-operand1 x) char-mask char-tag si))
+     (emit-tag-check (primcall-operand1 x) char-mask char-tag si env))
     ((boolean?)
-     (emit-tag-check (primcall-operand1 x) boolean-mask boolean-tag si))
+     (emit-tag-check (primcall-operand1 x) boolean-mask boolean-tag si env))
     ((+)
-     (emit-expr (primcall-operand2 x) si)
+     (emit-expr (primcall-operand2 x) si env)
      (emit "mov %rax, ~a(%rsp)" si)
-     (emit-expr (primcall-operand1 x) (- si wordsize))
+     (emit-expr (primcall-operand1 x) (- si wordsize) env)
      (emit "add ~a(%rsp), %rax" si))
     ((-)
-     (emit-expr (primcall-operand2 x) si)
+     (emit-expr (primcall-operand2 x) si env)
      (emit "mov %rax, ~a(%rsp)" si)
-     (emit-expr (primcall-operand1 x) (- si wordsize))
+     (emit-expr (primcall-operand1 x) (- si wordsize) env)
      (emit "sub ~a(%rsp), %rax" si))
     ((*)
-     (emit-expr (primcall-operand2 x) si)
+     (emit-expr (primcall-operand2 x) si env)
      (emit "mov %rax, ~a(%rsp)" si)
-     (emit-expr (primcall-operand1 x) (- si wordsize))
+     (emit-expr (primcall-operand1 x) (- si wordsize) env)
      (emit "imul ~a(%rsp), %rax" si)
      ;; When two fixnums (which have 2 tag bits) are multiplied, the
      ;; relevant bits for the result are now 4 bytes to the left, so
      ;; we have to shift back 2 bytes.
      (emit "shr $~a, %rax" fixnum-shift))
     ((=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env))
     ((<)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setl" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setl" si env))
     ((<=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setle" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setle" si env))
     ((>)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setg" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setg" si env))
     ((>=)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setge" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "setge" si env)
     ((eq?)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env)))
     ((char=?)
-     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si))
+     (emit-comparison (primcall-operand1 x) (primcall-operand2 x) "sete" si env))
     (else
      (error "unknown primcall op" (primcall-op x)))))
 
+(define (emit-let bindings body si env)
+  (define (lhs b)
+    (first b))
+  (define (rhs b)
+    (second b))
+  (let loop ((b* bindings) (new-env env) (si si))
+    (if (null? b*)
+        (emit-expr body si new-env)
+        (let ((b (first b*)))
+          (emit-expr (rhs b) si env)
+          (emit "mov %rax, ~a(%rsp)" si)
+          (loop (cdr b*)
+                (extend-env (lhs b) si new-env)
+                (- si wordsize))))))
 
-(define (emit-expr x si)
+(define (emit-expr x si env)
   (cond
    ((immediate? x)
     (emit "mov $~a, %rax" (immediate-rep x)))
+   ((variable? x)
+    (emit "mov ~a(%rsp), %rax" (lookup x env)))
+   ((let? x)
+    (emit-let (bindings x) (body x) si env))
    ((primcall? x)
-    (emit-primitive-call x si))
+    (emit-primitive-call x si env))
    (else
     (error "unknown expression" x))))
 
 (define (compile-program x)
-  (emit-expr x (- wordsize))
+  (emit-expr x (- wordsize) '())
   (emit "ret"))
 
 (define (compile-and-run x)
@@ -241,4 +280,6 @@ scheme_entry:
   (test-case '(>= 2 1) "#t")
   (test-case '(>= 2 2) "#t")
   (test-case '(char=? #\a #\b) "#f")
-  (test-case '(char=? #\b #\b) "#t"))
+  (test-case '(char=? #\b #\b) "#t")
+  (test-case '(let ((x 1)) x) "1")
+  (test-case '(let ((x 1) (y 2)) (+ x y)) "3"))