Add ast-traverse helper

[scheme.git] / codegen.scm

diff --git a/codegen.scm b/codegen.scm
index d30adc54e61a144097c3b0bb541a5835af8c028a..70a8ca4aa0df75518989d386502765e90e535137 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -51,12 +51,17 @@
         (inner-si (- si (* (length bindings) wordsize)))
         (names (map car bindings))
         (exprs (map cadr 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)
+
+        ; recursive let bindings: build environment as we go
+        (inner-env (fold-left
+                    (lambda (env name expr offset)

                       (codegen-expr expr inner-si env)
                       (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))
 
 (define (codegen-var name si env)
   (when (not (assoc name env))


@@ -131,10 +136,10 @@
        ))))                    ; move args and capture vars to stack
 
 (define (codegen-expr e si env)
        ))))                    ; move args and capture vars to stack
 
 (define (codegen-expr e si env)

-  (cond ((builtin? e) e)
-       ((closure? e) e)
-       
-       ((app? e)
+  (case (ast-type e)
+    ('builtin e)
+    ('closure e)
+    ('app

      (let ((callee (codegen-expr (car e) si env)))
        (case callee
         ('+ (codegen-add (cdr e) si env))
      (let ((callee (codegen-expr (car e) si env)))
        (case callee
         ('+ (codegen-add (cdr e) si env))


@@ -144,29 +149,34 @@
         ('bool->int (codegen-expr (cadr e) si env))
         (else (codegen-call callee (cdr e) si env)))))
 
         ('bool->int (codegen-expr (cadr e) si env))
         (else (codegen-call callee (cdr e) si env)))))
 

-       ((let? e) (codegen-let
-                  (let-bindings e)
+    ('let (codegen-let (let-bindings e)

                       (let-body e)
                       si
                       env))
                       (let-body e)
                       si
                       env))

-       ((var? e) (codegen-var e si env))
-       ((boolean? e) (emit "movq $~a, %rax" (if e 1 0)))
-       (else (emit "movq $~a, %rax" e))))
+
+    ('var (codegen-var e si env))
+
+    ('string-literal (emit "movq ~a, %rax" label))
+    ('bool-literal (emit "movq $~a, %rax" (if e 1 0)))
+    ('int-literal (emit "movq $~a, %rax" e))
+
+    (else (error #f "don't know how to codegen this"))))
+

 
 (define (fold-map f x) (fold-left append '() (map f x)))
 
 (define (free-vars prog)
   (define bound '())
   (define (collect e)
 
 (define (fold-map f x) (fold-left append '() (map f x)))
 
 (define (free-vars prog)
   (define bound '())
   (define (collect e)

-    (cond
-     ((builtin? e) '()) ; do nothing
-     ((var? e) (if (memq e bound) '() (list e)))
-     ((lambda? e)
+    (case (ast-type e)
+      ('builtin '()) ; do nothing
+      ('var (if (memq e bound) '() (list e)))
+      ('lambda

          (set! bound (append (lambda-args e) bound))
        (collect (lambda-body e)))
 
          (set! bound (append (lambda-args e) bound))
        (collect (lambda-body e)))
 

-     ((app? e) (fold-map collect e))
-     ((let? e)
+      ('app (fold-map collect e))
+      ('let

          (let ((bind-fvs (fold-map (lambda (a)
                                      ((set! bound (cons (car a) bound))
                                       (collect (cdr a))))
          (let ((bind-fvs (fold-map (lambda (a)
                                      ((set! bound (cons (car a) bound))
                                       (collect (cdr a))))


@@ -176,9 +186,6 @@
       (else '())))
   (collect prog))
 
       (else '())))
   (collect prog))
 

-(define (closure? e)
-  (and (list? e) (eqv? (car e) 'closure)))
-

                                        ; ((lambda (x) (+ x 1)) 42) => {lambda0: (x) (+ x 1)}, (@lambda0 42)
 (define (extract-lambdas program)
   (define lambdas '())
                                        ; ((lambda (x) (+ x 1)) 42) => {lambda0: (x) (+ x 1)}, (@lambda0 42)
 (define (extract-lambdas program)
   (define lambdas '())


@@ -191,17 +198,19 @@
       (set! lambdas (cons new-lambda lambdas))
       `(closure ,label ,captured))) ; todo: should we string->symbol?
   (define (extract e)
       (set! lambdas (cons new-lambda lambdas))
       `(closure ,label ,captured))) ; todo: should we string->symbol?
   (define (extract e)

-    (cond
-     ((lambda? e) (add-lambda e))
-     ((let? e) `(let
+    (case (ast-type e)
+     ('lambda (add-lambda e))
+     ('let `(let

                    ,(map extract (let-bindings e))
                  ,@(map extract (let-body e))))
                    ,(map extract (let-bindings e))
                  ,@(map extract (let-body e))))

-     ((app? e) (append (list (extract (car e)))
+     ('app (append (list (extract (car e)))

                       (map extract (cdr e))))
      (else e)))
   (let ((transformed (extract program)))
     (cons lambdas transformed)))
 
                       (map extract (cdr e))))
      (else e)))
   (let ((transformed (extract program)))
     (cons lambdas transformed)))
 

+;(define (extract-strings program))
+

 (define (amd64-abi f)
                                        ; preserve registers
   (emit "push %rbp")
 (define (amd64-abi f)
                                        ; preserve registers
   (emit "push %rbp")


@@ -243,8 +252,6 @@
     (else (error #f "need to test out the below"))
     (else (format "~a(%rsp)" (- n 6)))))
 
     (else (error #f "need to test out the below"))
     (else (format "~a(%rsp)" (- n 6)))))
 

-                
-

 (define (codegen program)
   (let* ((extract-result (extract-lambdas program))
         (lambdas (car extract-result))
 (define (codegen program)
   (let* ((extract-result (extract-lambdas program))
         (lambdas (car extract-result))