add more tests

aarch64var.rkt

@@ -0,0 +1,25 @@
+#lang racket
+
+(provide Label Var Reg Imm LMov Add Sub RetDefault Svc Bl)
+
+(require racket/struct)
+
+(struct AArch64VarProgram (info labeled-seq) #:transparent)
+(struct Label (label) #:transparent)
+(struct Var (var-name) #:transparent)
+(struct Reg (reg-name) #:transparent)
+(struct Imm (immediate) #:transparent)
+(struct LMov (src dest) #:transparent)
+(struct Add (op1 op2 dest) #:transparent)
+(struct Sub (op1 op2 dest) #:transparent)
+(struct RetDefault () #:transparent)
+(struct Svc (i) #:transparent)
+(struct Bl (label) #:transparent)
+
+(define valid-reg-names
+  '(x0 x1 x2 x3 x4 x5 x6
+    x7 x8 x9 x10 x11 x12
+    x13 x14 x15 x16 x17 x18
+    x19 x20 x21 x22 x23 x24
+    x25 x26 x27 x28 x29 x30
+    sp pc xzr))

complete-tests.rkt

@@ -46,7 +46,11 @@
   (test-suite
    "Complete Tests"
    (complete-rvar-test
-     "Simple RVar Tests"
+     "Simple addition"
+     "complete-tests/test0.rvar"
+     "complete-tests/test0.bril")
+   (complete-rvar-test
+     "Simple addition with subexpression"
      "complete-tests/test1.rvar"
      "complete-tests/test1.bril")))
     

complete-tests/test0.bril

@@ -0,0 +1,44 @@
+{
+  "functions": [
+    {
+      "args": [],
+      "instrs": [
+        {
+          "label": "start"
+        },
+        {
+          "dest": "tmp.0",
+          "op": "const",
+          "type": "int",
+          "value": 1
+        },
+        {
+          "dest": "tmp.1",
+          "op": "const",
+          "type": "int",
+          "value": 2
+        },
+        {
+          "args": [
+            "tmp.0",
+            "tmp.1"
+          ],
+          "dest": "tmp.2",
+          "funcs": [],
+          "labels": [],
+          "op": "add",
+          "type": "int"
+        },
+        {
+          "args": [
+            "tmp.2"
+          ],
+          "funcs": [],
+          "labels": [],
+          "op": "return"
+        }
+      ],
+      "name": "main"
+    }
+  ]
+}

complete-tests/test0.rvar

@@ -0,0 +1,3 @@
+(Program '() 
+ (Prim '+ 
+  (list (Int 1) (Int 2))))

select-instr.rkt

@@ -0,0 +1,39 @@
+#lang racket
+
+(require (prefix-in bril: bril/lang))
+(require "aarch64var.rkt")
+
+(define (bril-function-to-aarch64var function)
+  (match function
+    [(bril:Function name args ret-type instrs)
+     (foldr append '()
+            (map bril-instr-to-aarch64var instrs))]))
+
+; only deals with int64 type!
+(define (bril-instr-to-aarch64var bril-instr)
+  (match bril-instr
+   [(bril:Label label) (list (Label label))]
+   [(bril:ConstantInstr dest-name _ (bril:Int const-val))
+    (list (LMov (Imm const-val) (Var dest-name)))]
+   [(bril:ValueInstr op dest type args _ _)
+    (bril-value-instr-to-aarch64 op dest args)]
+   [(bril:EffectInstr op args _ _)
+    (match op
+     ['return (bril-return-to-aarch64var args)])]))
+
+(define (bril-value-instr-to-aarch64 op dest args)
+  (case op
+    ['add (list (Add (Var (list-ref args 0))
+                     (Var (list-ref args 1))
+                     (Var dest)))]
+    ['sub (list (Sub (Var (list-ref args 0))
+                     (Var (list-ref args 1))
+                     (Var dest)))]))
+
+(define (bril-return-to-aarch64var args)
+  (match args
+    [(list var)
+     (list (LMov (Reg 'x0) (Var (list-ref args 0)))
+           (RetDefault))]
+    [_ (list (RetDefault))]))
+       

tests/all-tests.rkt

@@ -10,6 +10,7 @@
 ;(require "test-remove-complex-opera.rkt")
 ;(require "test-explicate-control.rkt")
 (require "test-cvar-to-bril.rkt")
+(require "test-select-instr.rkt")
 
 (define all-tests
   (test-suite
@@ -20,5 +21,6 @@
    uniquify-tests
    ;remove-complex-opera-tests
    ;explicate-control-tests
-   cvar-to-bril-tests))
+   cvar-to-bril-tests
+   select-instr-tests))
    

tests/test-select-instr.rkt

@@ -0,0 +1,56 @@
+#lang racket
+
+(provide select-instr-tests)
+
+(require rackunit)
+
+(require (prefix-in bril: bril/lang))
+(require "../aarch64var.rkt")
+(require/expose "../select-instr.rkt" 
+                (bril-instr-to-aarch64var bril-function-to-aarch64var))
+
+(define bril-label (bril:Label "main"))
+(define bril-add
+  (bril:ValueInstr 'add "a" (bril:Type 'int) '("c" "d") '() '()))
+(define bril-const
+  (bril:ConstantInstr "a" (bril:Type 'int) (bril:Int 21)))
+(define bril-return
+  (bril:EffectInstr 'return '("x") '() '()))
+
+(define bril-func
+  (bril:Function "main" '() (bril:Type 'int)
+                 (list bril-label bril-add bril-return)))
+
+(define select-instr-tests
+  (test-suite
+   "Instruction Selection Tests"
+   (test-suite
+     "Single instruction selection"
+     (test-case
+       "Label"
+       (check-equal? (bril-instr-to-aarch64var bril-label)
+                     (list (Label "main"))))
+     (test-case
+       "Addition"
+       (check-equal? (bril-instr-to-aarch64var bril-add)
+                     (list (Add (Var "c") (Var "d") (Var "a")))))
+     (test-case
+       "Constant Instr"
+       (check-equal? (bril-instr-to-aarch64var bril-const)
+                     (list (LMov (Imm 21) (Var "a")))))
+     (test-case
+       "Return"
+       (check-equal? (bril-instr-to-aarch64var bril-return)
+                     (list (LMov (Reg 'x0) (Var "x"))
+                           (RetDefault)))))
+   (test-suite
+     "Function translation"
+     (test-case
+        "Simple function"
+        (check-equal? (bril-function-to-aarch64var bril-func)
+                      (list (Label "main")
+                            (Add (Var "c") (Var "d") (Var "a"))
+                            (LMov (Reg 'x0) (Var "x"))
+                            (RetDefault)))))))
+
+