11 files changed, 239 insertions, 0 deletions
diff --git a/src/backend/ast/ir.scm b/src/backend/ast/ir.scm
new file mode 100644
index 0000000..102739c
--- /dev/null
+++ b/src/backend/ast/ir.scm
@@ -0,0 +1,50 @@
+(define-module (backend ast ir)
+  #:export (prog
+            srout
+            neg
+            not
+            mov
+            stack
+            reg
+            imm
+            tmp
+            ret))
+
+;;; Commentary:
+;;;
+;;; Nodes which exist to do nothing when evaluated.
+;;;
+;;; Code:
+
+(define (ir-node type . args)
+  (cons type args))
+
+(define (prog func)
+  (ir-node 'prog func))
+
+(define (srout label instrs)
+  (ir-node 'srout label instrs))
+
+(define (neg dst)
+  (ir-node 'neg dst))
+
+(define (not dst)
+  (ir-node 'not dst))
+
+(define (mov src dst)
+  (ir-node 'mov src dst))
+
+(define (stack val)
+  (ir-node 'stack val))
+
+(define (reg val)
+  (ir-node 'reg val))
+
+(define (imm val)
+  (ir-node 'imm val))
+
+(define (tmp num)
+  (ir-node 'tmp num))
+
+(define (ret)
+  (ir-node 'ret))
diff --git a/src/backend/emitter/driver.scm b/src/backend/emitter/driver.scm
new file mode 100644
index 0000000..bd65d5a
--- /dev/null
+++ b/src/backend/emitter/driver.scm
@@ -0,0 +1,6 @@
+(define-module (backend emitter driver)
+  #:export (assembly->string))
+
+
+(define (assembly->string n)
+  (eval n (resolve-module '(backend emitter traverse))))
diff --git a/src/backend/emitter/traverse.scm b/src/backend/emitter/traverse.scm
new file mode 100644
index 0000000..0a5b4cc
--- /dev/null
+++ b/src/backend/emitter/traverse.scm
@@ -0,0 +1,50 @@
+(define-module (backend emitter traverse)
+  #:export (prog
+            subrout
+            instr
+            allocate
+            mov
+            ret
+            neg
+            not
+            allocate
+            reg
+            stack
+            imm))
+
+
+(define (prog srout)
+  (string-append/shared srout ".section .note.GNU-stack,\"\",@progbits\n"))
+
+(define (srout label instrs)
+  (format #f "    .globl ~a
+~a:
+\tpushq\t%rbp
+\tmovq\t%rsp, %rbp
+~a" label label (apply string-append/shared instrs)))
+
+(define (mov src dst)
+  (format #f "\tmovl\t~a, ~a\n" src dst))
+
+(define (ret)
+  "\tmovq\t%rbp, %rsp
+\tpopq\t%rbp
+\tret\n")
+
+(define (neg dst)
+  (format #f "\tnegl\t~a\n" dst))
+
+(define (not dst)
+  (format #f "\tnotl\t~a\n" dst))
+
+(define (alloc size)
+  (format #f "\tsubq\t$~a, %rsp\n" size))
+
+(define (reg r)
+  (format #f "%~a" r))
+
+(define (stack loc)
+  (format #f "~a(%rbp)" loc))
+
+(define (imm int)
+  (format #f "$~a" int))
diff --git a/src/backend/generator/allocate.scm b/src/backend/generator/allocate.scm
new file mode 100644
index 0000000..0d417db
--- /dev/null
+++ b/src/backend/generator/allocate.scm
@@ -0,0 +1,16 @@
+(define-module (backend generator allocate)
+  #:use-module (backend utils assign-stack)
+  #:export (expansion->allocate))
+
+
+(define (expansion->allocate ast)
+  (define (allocate n)
+    (cond
+     ((null? n) n)
+     ((eq? (car n) 'tmp)
+      (list 'stack (make-location (cadr n))))
+     ((list? (car n))
+      (cons (allocate (car n)) (allocate (cdr n))))
+     (#t
+      (cons (car n) (allocate (cdr n))))))
+  (allocate ast))
diff --git a/src/backend/generator/assembly.scm b/src/backend/generator/assembly.scm
new file mode 100644
index 0000000..8a110f3
--- /dev/null
+++ b/src/backend/generator/assembly.scm
@@ -0,0 +1,18 @@
+(define-module (backend generator assembly)
+  #:use-module (backend ast ir)
+  #:use-module (backend utils assign-stack)
+  #:use-module (backend utils merge-instructions)
+  #:export (instrs
+            mov))
+
+
+(define (instrs lst)
+  (cons 'list (cons (list 'alloc (abs (get-frame-size)))
+                    (merge-instr lst))))
+
+(define (mov src dst)
+  (if (and (eq? 'stack (car dst))
+           (eq? 'stack (car src)))
+      (append (list (list 'mov src (reg "r10d")))
+              (list (list 'mov (reg "r10d") dst)))
+      (list 'mov src dst)))
diff --git a/src/backend/generator/driver.scm b/src/backend/generator/driver.scm
new file mode 100644
index 0000000..6625388
--- /dev/null
+++ b/src/backend/generator/driver.scm
@@ -0,0 +1,9 @@
+(define-module (backend generator driver)
+  #:use-module (backend generator allocate)
+  #:export (tacky->assembly))
+
+
+(define (tacky->assembly n)
+  (eval (expansion->allocate
+         (eval n (resolve-module '(backend generator expansion))))
+        (resolve-module '(backend generator assembly))))
diff --git a/src/backend/generator/expansion.scm b/src/backend/generator/expansion.scm
new file mode 100644
index 0000000..9fe2e0a
--- /dev/null
+++ b/src/backend/generator/expansion.scm
@@ -0,0 +1,23 @@
+(define-module (backend generator expansion)
+  #:use-module (backend ast ir)
+  #:use-module (backend utils merge-instructions)
+  #:export (instrs
+            not
+            neg
+            ret))
+
+
+(define (instrs lst)
+  #f
+  (list 'instrs (cons 'list (merge-instr lst))))
+
+(define (not src dst) (unary 'not src dst))
+(define (neg src dst) (unary 'neg src dst))
+
+(define (ret src)
+  (list (list 'mov src (list 'reg "eax"))
+        (list 'ret)))
+
+(define (unary op src dst)
+  (list (list 'mov src dst)
+        (list op dst)))
diff --git a/src/backend/tacky/driver.scm b/src/backend/tacky/driver.scm
new file mode 100644
index 0000000..b9585c7
--- /dev/null
+++ b/src/backend/tacky/driver.scm
@@ -0,0 +1,6 @@
+(define-module (backend tacky driver)
+  #:export (ast->tacky))
+
+
+(define (ast->tacky n)
+  (eval n (resolve-module '(backend tacky traverse))))
diff --git a/src/backend/tacky/traverse.scm b/src/backend/tacky/traverse.scm
new file mode 100644
index 0000000..9a1b7aa
--- /dev/null
+++ b/src/backend/tacky/traverse.scm
@@ -0,0 +1,39 @@
+(define-module (backend tacky traverse)
+  #:use-module (backend ast ir)
+  #:export (func
+            stmt
+            unary
+            const))
+
+
+(define (func name instrs)
+  (list 'srout name instrs))
+
+(define (stmt val)
+  (list 'instrs
+        (cons 'list (append (cdr val)
+                            (list (list 'ret (car val)))))))
+
+(define (expr op val)
+  (make-instruction op (car val) (cdr val)))
+
+(define (const val)
+  (cons (imm val) '()))
+
+(define (make-instruction op src instrs)
+  (let ((dst (make-temporary)))
+    (cons dst
+          (append instrs
+                  (list (op src dst))))))
+
+(define make-temporary
+  (let ((count 100))
+    (lambda ()
+      (set! count (1+ count))
+      (list 'tmp count))))
+
+(define (neg src dst)
+  (list 'neg src dst))
+
+(define (not src dst)
+  (list 'not src dst))
diff --git a/src/backend/utils/assign-stack.scm b/src/backend/utils/assign-stack.scm
new file mode 100644
index 0000000..dff9fc7
--- /dev/null
+++ b/src/backend/utils/assign-stack.scm
@@ -0,0 +1,15 @@
+(define-module (backend utils assign-stack)
+  #:export (make-location
+            get-frame-size))
+
+
+(define make-location)
+(define get-frame-size)
+(let ((dict (make-hash-table))
+      (ptr 0))
+  (set! make-location
+        (lambda (id)
+          (or (hash-ref dict id)
+              (begin (set! ptr (1+ ptr))
+                     (hash-set! dict id (get-frame-size))))))
+  (set! get-frame-size (lambda () (* -4 ptr))))
diff --git a/src/backend/utils/merge-instructions.scm b/src/backend/utils/merge-instructions.scm
new file mode 100644
index 0000000..f9fc043
--- /dev/null
+++ b/src/backend/utils/merge-instructions.scm
@@ -0,0 +1,7 @@
+(define-module (backend utils merge-instructions)
+  #:use-module (srfi srfi-1)
+  #:export (merge-instr))
+
+
+(define (merge-instr lst)
+  (append-map (lambda (x) (if (list? (car x)) x (list x))) lst))