Add recursive let-bindings

[scheme.git] / codegen.scm

diff --git a/codegen.scm b/codegen.scm
index 04816ab75d533b6b950ff7fe17813cfce1880383..e1b51a60a5ac6c9fcde9f23dd4ca58e9c02f2274 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -51,14 +51,21 @@
         (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)
+
+        ; recursive let bindings: build environment as we go
+        (inner-env (fold-left
+                    (lambda (env name 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)))
+                      (emit "movq %rax, ~a(%rsp)" offset)
+                      (cons (cons name offset) env))
+                    env names exprs stack-offsets)))
+    (for-each (lambda (form)
+               (codegen-expr form inner-si inner-env))
+             body)))
 
 (define (codegen-var name si env)
+  (when (not (assoc name env))
+    (error #f (format "Variable ~a is not bound" name)))
   (let ((offset (cdr (assoc name env))))
     (emit "movq ~a(%rsp), %rax" offset)))
 
@@ -259,10 +266,10 @@
     (amd64-abi
      (lambda () (codegen-expr xform-prog 0 '())))))
 
-(define (compile-to-binary program)
+(define (compile-to-binary program output)
   (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
   (let ([tmp-path "/tmp/a.s"])
     (when (file-exists? tmp-path) (delete-file tmp-path))
     (with-output-to-file tmp-path
       (lambda () (codegen program)))
-    (system "clang -fomit-frame-pointer /tmp/a.s rts.c")))
+    (system (format "clang -fomit-frame-pointer /tmp/a.s rts.c -o ~a" output))))