Add utility to print bril from a CVar program

print-rvar-to-bril.rkt

@@ -0,0 +1,17 @@
+#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 monadic normal form
+; Transform the program into administrative normal form (ANF)
 ; 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,6 +21,7 @@
     [(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,6 +23,7 @@
            [(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

@@ -1,65 +0,0 @@
-#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,4 +22,3 @@
 (for ([program listings])
  (test-eq (interp-RVar (list-ref listings 0))
           (evaluate-bril-main (pass (list-ref listings 0)))))
-

test-cvar.rkt

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

test-remove-complex-opera.rkt

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

test-rint.rkt

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

test-rvar.rkt

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

test-select-instructions.rkt

@@ -1,71 +0,0 @@
-#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

@@ -1,15 +0,0 @@
-#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,8 +1,9 @@
 #lang racket
 
+(provide test-uniquify-tests)
+
 (require rackunit)
 
-(require "test-util.rkt")
 (require "rvar.rkt")
 (require "uniquify.rkt")
 (require/expose "uniquify.rkt" (uniquify-exp))
@@ -12,56 +13,6 @@
   (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 '()
@@ -75,6 +26,69 @@
                         (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)])
-   (test-eq (interp-RVar program)
+       (check-equal? (interp-RVar program)
-            (interp-RVar (uniquify program))))
+        (interp-RVar (uniquify program)))))))

uncover-locals.rkt

@@ -1,22 +0,0 @@
-#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))]))