print-rvar-to-bril.rkt

@@ -1,17 +0,0 @@
-#lang racket
-
-(provide print-rvar-bril)
-
-(require (prefix-in bril: bril/lang))
-(require "cvar-to-bril.rkt")
-(require "uniquify.rkt")
-(require "remove-complex-oper.rkt")
-(require "explicate-control.rkt")
-(require "rvar.rkt")
-
-(define (print-rvar-bril program)
- (bril:write-bril
-  (cvar-to-bril
-   (explicate-control
-    (remove-complex-opera*-2
-     (uniquify program))))))

remove-complex-oper.rkt

@@ -132,7 +132,7 @@
              new-tmpcount))]))
 
 ; remove complex sub-expression 
-; Transform the program into administrative normal form (ANF)
+; Transform the program into monadic normal form
 ; This version of remove-complex-opera* is more aggressive
 ; Every main expression must be saved in a temporary,
 ; and every argument (e.g. of Prim) must be a variable

rint.rkt

@@ -21,7 +21,6 @@
     [(Int n) n]
     [(Prim 'read '()) (read-fixnum)]
     [(Prim '- (list e)) (fx- 0 (interp-exp e))]
-    [(Prim '- (list e1 e2)) (fx- (interp-exp e1) (interp-exp e2))]
     [(Prim '+ (list e1 e2)) (fx+ (interp-exp e1) (interp-exp e2))]))
 
 (define (interp-RInt p)

rvar.rkt

@@ -23,7 +23,6 @@
            [(Var name) (eval-symbol env name)]
            [(Prim 'read '()) (read-fixnum)]
            [(Prim '- (list e)) (fx- 0 ((interp-exp env) e))]
-           [(Prim '- `(,e1 ,e2)) (fx- ((interp-exp env) e1) ((interp-exp env) e2))]
            [(Prim '+ `(,e1 ,e2)) (fx+ ((interp-exp env) e1) ((interp-exp env) e2))]
            [(Let var rexp body)
             (let ([value ((interp-exp env) rexp)])

select-instructions.rkt

@@ -0,0 +1,65 @@
+#lang racket
+
+(require racket/list)
+
+(provide select-instructions)
+
+(define (select-instructions p)
+  (match p
+    [`(program ,data ,body) `(AArch64VProgram ,data ,(select-instructions-section (car body)))]))
+
+(define (select-instructions-section sec)
+  (match sec
+    [`(,label . ,statement) `(,label . (Block `() ,(select-instructions-stmt statement)))]))
+
+(define (select-instructions-stmt stmt)
+  (match stmt
+    [`(return ,exp) (select-instructions-return exp)]
+    [`(seq (assign ,var ,exp) ,next-stmt) 
+      (append (select-instructions-assign var exp) 
+              (select-instructions-stmt next-stmt))]))
+
+(define (select-instructions-assign var exp)
+  (match exp
+         [(? symbol?) (list `(Instr mov ((Var ,var) (Var ,exp))))]
+         [(? fixnum?) (list `(Instr mov ((Var ,var) (Imm ,exp))))]
+         [`(read)     (select-instructions-read `(Var ,var))]
+         [`(- ,e)     (select-instructions-neg e `(Var ,var))]
+         [`(+ ,a ,b)  (select-instructions-add a b `(Var ,var))]))
+
+(define (select-instructions-return exp)
+  (append (match exp
+                [(? symbol?) (list `(Instr mov (x0 (Var ,exp))))]
+                [(? fixnum?) (list `(Instr mov (x0 (Imm ,exp))))]
+                [`(read)     (select-instructions-read 'x0)]
+                [`(- ,e)     (select-instructions-neg e 'x0)]
+                [`(+ ,a ,b)  (select-instructions-add a b 'x0)])
+          `[(Instr b (conclusion))]))
+
+(define (select-instructions-read dest)
+  (if (eq? dest 'x0)
+      (list `(Instr bl _builtin_read))
+      (list `(Instr bl _builtin_read) `(Instr mov (,dest x0)))))
+
+(define (select-instructions-neg exp dest)
+  (begin
+    (define var-exp (if (fixnum? exp)
+                        `(Imm ,exp)
+                        `(Var ,exp)))
+    (list `(Instr neg (,dest ,var-exp)))))
+
+(define (select-instructions-add a b dest)
+  (begin
+    ; if e1 is an imm, swap
+    (define-values (e1 e2) (imm-to-right a b))
+    (define num-imm (count fixnum? (list e1 e2)))
+    (match num-imm
+           [0 (list `(Instr add (,dest (Var ,e1) (Var ,e2))))]
+           [1 (list `(Instr add (,dest (Var ,e1) (Imm ,e2))))]
+           [2 (list `(Instr mov (,dest (Imm ,e1)))
+                    `(Instr add (,dest ,dest (Imm ,e2))))])))
+           
+(define (imm-to-right e1 e2)
+  (if (and (fixnum? e1) (not (fixnum? e2)))
+      (values e2 e1)
+      (values e1 e2)))

test-cvar-to-bril.rkt

@@ -22,3 +22,4 @@
 (for ([program listings])
  (test-eq (interp-RVar (list-ref listings 0))
           (evaluate-bril-main (pass (list-ref listings 0)))))
+

test-cvar.rkt

@@ -1,8 +1,5 @@
 #lang racket
 
-(provide cvar-tests)
-
-(require rackunit)
 (require "test-util.rkt")
 (require "cvar.rkt")
 
@@ -10,42 +7,33 @@
     (Return (Int 0)))
 
 (define seq-2
-    (Seq (Assign (Var 'x) (Int 3))
-     (Return (Prim '- (list (Int 1) (Var 'x))))))
-
-(define seq-3
     (Seq (Assign (Var 'x) (Int 42))
      (Return (Int 42))))
 
-(define seq-4
+(define seq-3
     (Seq (Assign (Var 'x) (Int 42))
      (Return (Prim '+ (list (Int 1) (Var 'x))))))
 
-(define seq-5
+(define seq-4
     (Return (Prim 'read '())))
 
 (define (make-start-seq seq)
     (CProgram '() `((start . ,seq))))
 
-(define cvar-tests
- (test-suite
-  "CVar tests"
-  (test-case
-   "CVar interpretation tests"
-   (check-equal?
-      (interp-CVar (make-start-seq seq-1))
-      0)
-   (check-equal?
-      (interp-CVar (make-start-seq seq-2))
-      -2)
-   (check-equal?
-      (interp-CVar (make-start-seq seq-3))
-      42)
-   (check-equal?
-      (interp-CVar (make-start-seq seq-4))
-      43)
-   (with-input-from-num-list '(21)
-    (lambda ()
-     (check-equal?
-        (interp-CVar (make-start-seq seq-5))
-        21))))))
+(test-eq
+   (interp-CVar (make-start-seq seq-1))
+   0)
+
+(test-eq
+   (interp-CVar (make-start-seq seq-2))
+   42)
+
+(test-eq
+   (interp-CVar (make-start-seq seq-3))
+   43)
+
+(with-input-from-num-list '(21)
+ (lambda ()
+  (test-eq
+     (interp-CVar (make-start-seq seq-4))
+     21)))

test-remove-complex-opera.rkt

@@ -1,8 +1,7 @@
 #lang racket
 
-(provide remove-complex-opera-tests)
-
 (require rackunit)
+
 (require "test-util.rkt")
 (require "uniquify.rkt")
 (require "remove-complex-oper.rkt")

test-rint.rkt

@@ -1,8 +1,5 @@
 #lang racket
 
-(provide test-rint-tests)
-
-(require rackunit)
 (require "test-util.rkt")
 (require "rint.rkt")
 
@@ -12,19 +9,7 @@
 (define ast1.1 (Prim '+ (list rd neg-eight)))
 (define program (Program '() ast1.1))
 
-(define test-rint-tests
- (test-suite
-  "RInt interpretation tests"
-  (test-case
-   "program with input"
-   (check-equal?
-    -5
-    (with-input-from-num-list '(3)
-       (lambda () (interp-RInt program)))))
-  (test-case 
-   "simple difference"
-   (check-equal?
-    -3
-    (interp-RInt (Program '() (Prim '- (list (Int 5) (Int 8)))))))))
-
+(test-eq -5
+  (with-input-from-num-list '(3)
+     (lambda () (interp-RInt program))))
 

test-rvar.rkt

@@ -1,50 +1,39 @@
 #lang racket
 
-(provide test-rvar-tests)
-
-(require rackunit)
+(require "test-util.rkt")
 (require "rvar.rkt")
 
 (define (interp-exp env e)
   ((send (new interp-RVar-class) interp-exp env) e))
 
-(define test-rvar-tests
-    (test-suite 
-     "RVar interpretation testsuite"
+(test-eq
+  (let ([env `((a . 1) (b . 2))])
+    (interp-exp env (Var 'a)))
+  1)
 
-     (check-equal?
-       (let ([env `((a . 1) (b . 2))])
-         (interp-exp env (Var 'a)))
-       1)
+(test-eq
+  (let ([env `((a . 1) (b . 2))])
+    (interp-exp env (Prim '+ (list (Var 'a) (Int 3)))))
+  4)
 
-     (check-equal?
-       (let ([env `((a . 1) (b . 2))])
-         (interp-exp env (Prim '+ (list (Var 'a) (Int 3)))))
-       4)
+(test-eq
+  (let ([env `((a . 1) (b . 2))])
+    (interp-exp env (Prim '- `(,(Int 3)))))
+  -3)
 
-     (check-equal?
-       (let ([env `((a . 1) (b . 2))])
-         (interp-exp env (Prim '- `(,(Int 3)))))
-       -3)
+(test-eq
+  (let ([env `((a . 1) (b . 2))])
+    (interp-exp env (Prim '+ (list (Var 'a) (Prim `- (list (Var 'b)))))))
+  -1)
 
-     (check-equal?
-       (let ([env `((a . 1))])
-         (interp-exp env (Prim '- (list (Int 3) (Var 'a)))))
-       2)
+(test-eq
+  (interp-exp `() (Let 'a
+                       (Prim '+ (list (Int 1) (Int 2)))
+                       (Prim '+ (list (Var 'a) (Int 3)))))
+  6)
 
-     (check-equal?
-       (let ([env `((a . 1) (b . 2))])
-         (interp-exp env (Prim '+ (list (Var 'a) (Prim `- (list (Var 'b)))))))
-       -1)
-
-     (check-equal?
-       (interp-exp `() (Let 'a
-                            (Prim '+ (list (Int 1) (Int 2)))
-                            (Prim '+ (list (Var 'a) (Int 3)))))
-       6)
-
-     (check-equal?
-       (interp-RVar (Program `() (Let 'a
-                                      (Prim '+ (list (Int 1) (Int 2)))
-                                      (Prim '+ (list (Var 'a) (Int 3))))))
-       6)))
+(test-eq
+  (interp-RVar (Program `() (Let 'a
+                                 (Prim '+ (list (Int 1) (Int 2)))
+                                 (Prim '+ (list (Var 'a) (Int 3))))))
+  6)

test-select-instructions.rkt

@@ -0,0 +1,71 @@
+#lang racket
+
+(require "select-instructions.rkt")
+(require "test-util.rkt")
+
+(define programs
+    (list
+      `(program ()
+          ((start .
+            (return (+ 2 3)))))
+      `(program ()
+          ((start .
+            (seq (assign x 3)
+              (return (+ 2 x))))))
+      `(program ()
+          ((start .
+             (seq (assign tmp.1 (read))
+               (return (+ tmp.1 3))))))
+      `(program ()
+                ((start .
+                  (seq (assign tmp.1 (- 1))
+                       (seq (assign x.1 (+ tmp.1 2))
+                            (seq (assign tmp.2 (+ x.1 2))
+                                 (seq (assign tmp.3 (+ 4 5))
+                                      (return (+ tmp.2 tmp.3)))))))))))
+
+
+(test-eq (select-instructions (list-ref programs 0))
+         `(AArch64VProgram
+           ()
+           (start
+            Block
+            `()
+            ((Instr mov (x0 (Imm 2)))
+             (Instr add (x0 x0 (Imm 3)))
+             (Instr b (conclusion))))))
+
+(test-eq (select-instructions (list-ref programs 1))
+         `(AArch64VProgram
+           ()
+           (start
+            Block
+            `()
+            ((Instr mov ((Var x) (Imm 3)))
+             (Instr add (x0 (Var x) (Imm 2)))
+             (Instr b (conclusion))))))
+
+(test-eq (select-instructions (list-ref programs 2))
+         `(AArch64VProgram
+           ()
+           (start
+            Block
+            `()
+            ((Instr bl _builtin_read)
+             (Instr mov ((Var tmp.1) x0))
+             (Instr add (x0 (Var tmp.1) (Imm 3)))
+             (Instr b (conclusion))))))
+
+(test-eq (select-instructions (list-ref programs 3))
+         `(AArch64VProgram
+           ()
+           (start
+            Block
+            `()
+            ((Instr neg ((Var tmp.1) (Imm 1)))
+             (Instr add ((Var x.1) (Var tmp.1) (Imm 2)))
+             (Instr add ((Var tmp.2) (Var x.1) (Imm 2)))
+             (Instr mov ((Var tmp.3) (Imm 4)))
+             (Instr add ((Var tmp.3) (Var tmp.3) (Imm 5)))
+             (Instr add (x0 (Var tmp.2) (Var tmp.3)))
+             (Instr b (conclusion))))))

test-uncover-locals.rkt

@@ -0,0 +1,15 @@
+#lang racket
+
+(require "uncover-locals.rkt")
+(require "test-util.rkt")
+
+(define programs
+    (list
+     `(program ()
+               ((start . (seq (assign x.1 20) (seq (assign x.2 3) (return (+ x.1 x.2)))))))))
+
+(test-eq
+ (cadr (uncover-locals (list-ref programs 0)))
+ `(locals . (x.1 x.2)))
+
+

test-uniquify.rkt

@@ -1,9 +1,8 @@
 #lang racket
 
-(provide test-uniquify-tests)
-
 (require rackunit)
 
+(require "test-util.rkt")
 (require "rvar.rkt")
 (require "uniquify.rkt")
 (require/expose "uniquify.rkt" (uniquify-exp))
@@ -13,6 +12,56 @@
   (lambda (exp)
     (call-with-values (lambda () ((uniquify-exp symtable symtable) exp)) list)))
 
+(test-eq ((list-uniquify-exp (make-immutable-hash)) (Prim 'read (list)))
+        (list #hash() (Prim 'read '())))
+
+(let ([tbl (hash-set (make-immutable-hash) 'x 1)])
+  (test-eq ((list-uniquify-exp tbl) (Var 'x))
+           (list #hash((x . 1)) (Var 'x.1))))
+
+(test-eq ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Int 3)))
+         (list #hash((x . 1)) (Let 'x.1 (Int 2) (Int 3))))
+
+(test-eq ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Prim '+ (list (Var 'x) (Int 3)))))
+         (list #hash((x . 1)) (Let 'x.1 (Int 2) (Prim '+ (list (Var 'x.1) (Int 3))))))
+
+(test-eq (uniquify
+           (Program '()
+             (Let 'x (Int 32)
+               (Prim '+ (list (Let 'x (Int 10) (Var 'x)) (Var 'x))))))
+         (Program '()
+           (Let 'x.1 (Int 32)
+             (Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2)) (Var 'x.1))))))
+
+(test-eq (uniquify
+           (Program '()
+             (Let 'x (Int 32)
+               (Prim '- (list (Var 'x))))))
+         (Program '()
+           (Let 'x.1 (Int 32)
+             (Prim '- (list (Var 'x.1))))))
+
+
+(test-eq (uniquify
+           (Program '()
+             (Let 'x (Int 32)
+               (Prim '+ (list (Let 'x (Int 10) (Var 'x))
+                              (Let 'x (Int 3) (Var 'x))
+                              (Var 'x))))))
+         (Program '()
+           (Let 'x.1 (Int 32)
+             (Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2))
+                            (Let 'x.3 (Int 3) (Var 'x.3))
+                            (Var 'x.1))))))
+(test-eq (uniquify
+           (Program '()
+             (Let 'x (Let 'x (Int 4)
+                       (Prim '+ (list (Var 'x) (Int 1))))
+               (Prim '+ (list (Var 'x) (Int 2))))))
+         (Program '()
+           (Let 'x.1 (Let 'x.2 (Int 4)
+                       (Prim '+ (list (Var 'x.2) (Int 1))))
+             (Prim '+ (list (Var 'x.1) (Int 2))))))
 
 (define p1
         (Program '()
@@ -26,69 +75,6 @@
                         (Var 'y))
              (Prim '+ (list (Var 'x) (Int 5))))))
 
-(define test-uniquify-tests
-    (test-suite
-     "Uniquify pass testsuite"
-     (test-case
-      "uniquify-exp correctness"
-      (let ([tbl (hash-set (make-immutable-hash) 'x 1)])
-        (check-equal? ((list-uniquify-exp tbl) (Var 'x))
-                 (list #hash((x . 1)) (Var 'x.1))))
-
-      (check-equal? ((list-uniquify-exp (make-immutable-hash)) (Prim 'read (list)))
-              (list #hash() (Prim 'read '())))
-       
-      (check-equal? ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Int 3)))
-               (list #hash((x . 1)) (Let 'x.1 (Int 2) (Int 3))))
-       
-      (check-equal? ((list-uniquify-exp (make-immutable-hash)) (Let 'x (Int 2) (Prim '+ (list (Var 'x) (Int 3)))))
-               (list #hash((x . 1)) (Let 'x.1 (Int 2) (Prim '+ (list (Var 'x.1) (Int 3)))))))
-     (test-case
-      "uniqufication pass"
-       (check-equal?
-         (uniquify
-           (Program '()
-             (Let 'x (Int 32)
-               (Prim '+ (list (Let 'x (Int 10) (Var 'x)) (Var 'x))))))
-         (Program '()
-           (Let 'x.1 (Int 32)
-             (Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2)) (Var 'x.1))))))
-       
-       (check-equal?
-        (uniquify
-          (Program '()
-            (Let 'x (Int 32)
-              (Prim '- (list (Var 'x))))))
-        (Program '()
-          (Let 'x.1 (Int 32)
-            (Prim '- (list (Var 'x.1))))))
-       
-       
-       (check-equal?
-        (uniquify
-          (Program '()
-            (Let 'x (Int 32)
-              (Prim '+ (list (Let 'x (Int 10) (Var 'x))
-                             (Let 'x (Int 3) (Var 'x))
-                             (Var 'x))))))
-        (Program '()
-          (Let 'x.1 (Int 32)
-            (Prim '+ (list (Let 'x.2 (Int 10) (Var 'x.2))
-                           (Let 'x.3 (Int 3) (Var 'x.3))
-                           (Var 'x.1))))))
-       (check-equal?
-        (uniquify
-          (Program '()
-            (Let 'x (Let 'x (Int 4)
-                      (Prim '+ (list (Var 'x) (Int 1))))
-              (Prim '+ (list (Var 'x) (Int 2))))))
-        (Program '()
-          (Let 'x.1 (Let 'x.2 (Int 4)
-                      (Prim '+ (list (Var 'x.2) (Int 1))))
-            (Prim '+ (list (Var 'x.1) (Int 2)))))))
-
-     (test-case
-      "Uniquify interpretation"
-      (for ([program (list p1 p2)])
-       (check-equal? (interp-RVar program)
-        (interp-RVar (uniquify program)))))))
+(for ([program (list p1 p2)])
+   (test-eq (interp-RVar program)
+            (interp-RVar (uniquify program))))

uncover-locals.rkt

@@ -0,0 +1,22 @@
+#lang racket
+
+(provide uncover-locals)
+
+(define (uncover-locals p)
+  (match p
+    [`(program ,data ,c0-blocks)
+     `(program ,(append data (cons `locals (uncover-locals-blocks c0-blocks))) c0-blocks)]))
+
+(define (uncover-locals-blocks c0-blocks)
+  (if (empty? c0-blocks)
+    `()
+    (append (uncover-locals-block (car c0-blocks)) (uncover-locals-blocks (cdr c0-blocks)))))
+
+(define (uncover-locals-block c0-block)
+  (match c0-block
+   [`(,label . ,tail) (uncover-locals-tail tail)]))
+
+(define (uncover-locals-tail c0-tail)
+  (match c0-tail
+    [`(return ,exp) `()]
+    [`(seq (assign ,var ,exp) ,next) (cons var (uncover-locals-tail next))]))