X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=codegen.scm;h=10e005f8ad90e840aad396da4a0cdb5032163f6c;hb=8894a56619450d998be2cbbfd45c70f16d642936;hp=52df26ece76527068fd89a7c397c3ca632aeaef4;hpb=6b60f721c4be97e0a79e1b16028a5d180eb0ba1e;p=scheme.git

diff --git a/codegen.scm b/codegen.scm
index 52df26e..10e005f 100644
--- a/codegen.scm
+++ b/codegen.scm
@@ -76,11 +76,6 @@
     ('linux  (emit "mov $1, %rax"))) ; syscall 1 (write)
   (emit "syscall"))
 
-(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)
@@ -349,15 +344,15 @@
 	    (set! bound (append (lambda-args e) bound))
 	    (collect (lambda-body e))))
 
-      ('app (fold-map collect e))
-      ('if (fold-map collect (cdr e)))
+      ('app (flat-map collect e))
+      ('if (flat-map collect (cdr e)))
       ('let
-	  (let ([bind-fvs (fold-map (lambda (a)
+	  (let ([bind-fvs (flat-map (lambda (a)
 				      (begin
 					(set! bound (cons (car a) bound))
 					(collect (cdr a))))
 				    (let-bindings e))])
-	    (append bind-fvs (fold-map collect (let-body e)))))
+	    (append bind-fvs (flat-map collect (let-body e)))))
       (else '())))
   (collect prog))
 
@@ -523,7 +518,9 @@
 (define (codegen program)
   (set! cur-label 0)
   (set! cur-lambda 0)
-  (let* ((extract-res-0 (extract-strings program))
+  (let* ([body (program-body program)]	
+	 
+	 (extract-res-0 (extract-strings body))
 	 (strings (car extract-res-0))
 	 (extract-res-1 (extract-lambdas (cdr extract-res-0)))
 	 (lambdas (car extract-res-1))
@@ -541,7 +538,7 @@
 
     (emit "movq %rsp, %rbp")            ; set up the base pointer
     
-    (codegen-expr xform-prog wordsize '())
+    (codegen-expr xform-prog (- wordsize) '())
 
 					; exit syscall
     (emit "mov %rax, %rdi")
@@ -559,7 +556,7 @@
 
 (define (compile-to-binary program output t)
   (set! target t)
-  (when (not (eq? (typecheck program) 'int)) (error #f "not an int"))
+  (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