Refactor ast "pattern matching" to a single function

[scheme.git] / codegen.scm

diff --git a/codegen.scm b/codegen.scm
index e1b51a60a5ac6c9fcde9f23dd4ca58e9c02f2274..70a8ca4aa0df75518989d386502765e90e535137 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -136,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))


@@ -149,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))))


@@ -181,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 '())


@@ -196,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")


@@ -248,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))