X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=compiler.scm;h=76fa6717c46d9d1ae69a4dd28d9fcbb135739d05;hb=0c40996d3617183272518960d1b63f2b83c76f05;hp=351e11b7695f927121d574baef27924ed2d31f67;hpb=ba17902b367783f058108f2eb9dff163d34b735f;p=scheme.git

diff --git a/compiler.scm b/compiler.scm
index 351e11b..76fa671 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1,27 +1,63 @@
 (load "typecheck.scm")
+(load "ast.scm")
 
 (define (emit . s)
   (begin
     (apply printf s)
     (display "\n")))
 
-(define (compile-add xs)
+(define (codegen-add xs si env)
   (define (go ys)
     (if (null? ys)
       (emit "movq %rbx, %rax")
       (begin
-	(emit "addq $~a, %rbx" (car ys))
+	(let ((y (car ys)))
+	     (if (integer? y)
+		 (emit "addq $~a, %rbx" y)
+		 (begin
+		   (codegen-expr y si env)
+		   (emit "addq %rax, %rbx"))))
 	(go (cdr ys)))))
   (begin
     (emit "movq $0, %rbx")
     (go xs)))
 
-(define (compile-expr e)
-  (if (and (list? e) (eq? (car e) '+))
-      (compile-add (cdr e))
-      (emit "movq $~a, %rax" e)))
+(define (range s n)
+  (if (= 0 n) '()
+      (append (range s (- n 1))
+	      (list (+ s (- n 1))))))
+
+(define wordsize 8)
+
+(define (codegen-let bindings body si env)
+  (let* ((stack-offsets (map (lambda (x) (- si (* x wordsize)))
+			     (range 0 (length bindings))))
+	 (inner-si (- si (* (length bindings) wordsize)))
+	 (names (map car bindings))
+	 (exprs (map cadr bindings))
+	 (inner-env (append (map cons names stack-offsets) env)))
+  (for-each (lambda (expr offset)
+	      (codegen-expr expr inner-si env)
+	      (emit "movq %rax, ~a(%rsp)" offset))
+	    exprs stack-offsets)
+  (for-each (lambda (form) (codegen-expr form inner-si inner-env)) body)))
+
+(define (codegen-var name si env)
+  (let ((offset (cdr (assoc name env))))
+    (emit "movq ~a(%rsp), %rax" offset)))
+
+(define (codegen-expr e si env)
+  (cond ((and (list? e) (eq? (car e) '+))
+	 (codegen-add (cdr e) si env))
+	((let? e) (codegen-let
+		   (let-bindings e)
+		   (let-body e)
+		   si
+		   env))
+	((var? e) (codegen-var e si env))
+	(else (emit "movq $~a, %rax" e))))
 
-(define (compile-program program)
+(define (codegen program)
   (emit ".text")
   (emit ".p2align 4,,15")
   (emit ".globl _scheme_entry")
@@ -37,7 +73,7 @@
 	    '(12 13 14 15))
 
   ; our code goes here
-  (compile-expr program)
+  (codegen-expr program 0 '())
 
   ; restore preserved registers
   (for-each (lambda (i)
@@ -55,5 +91,5 @@
   (let ([tmp-path "/tmp/a.s"])
     (when (file-exists? tmp-path) (delete-file tmp-path))
     (with-output-to-file tmp-path
-      (lambda () (compile-program program)))
+      (lambda () (codegen program)))
     (system "clang -fomit-frame-pointer /tmp/a.s rts.c")))