Add CVar to bril translation

This pass only allows arguments to be variables.
The resulting language is:

let-expr := (Let symbol <simple-expr> <expr>)
simple-expr: (Int num) | (Var symbol) | (Prim op (list-of-symbols))
expr := let-expr | simple-expr
top-level := let-expr

Notably, every top level expression is assigned to a (temporary) variable.
This subset of CVar is particularly easy to translate into bril IR.

cvar-to-bril.rkt

@@ -0,0 +1,50 @@
+#lang racket
+
+(provide cvar-to-bril)
+
+(require (prefix-in bril: bril/lang))
+(require "cvar.rkt")
+
+(define (cvar-to-bril program)
+ (match program
+   [(CProgram _ body)
+    (bril:Program (list
+                   (bril:Function "main" '() '()
+                    (apply append (map cvar-labeled-seq-to-bril body)))))]))
+
+(define (cvar-labeled-seq-to-bril labeled-seq)
+ (match labeled-seq
+  [(cons label seq)
+   (cons
+    (bril:Label (symbol->string label))
+    (cvar-seq-to-bril seq))]))
+
+(define (cvar-seq-to-bril seq)
+ (match seq
+  [(Seq stmt tail)
+   (append
+    (cvar-stmt-to-bril stmt)
+    (cvar-seq-to-bril tail))]
+  [(Return var)
+   (list (bril:EffectInstr 'return (list (symbol->string (Var-name var)))
+                          '() '()))]))
+
+(define (cvar-stmt-to-bril stmt)
+ (match stmt
+  [(Assign (Var varname) rhs) (generate-bril-instrs (symbol->string varname) rhs)]))
+
+(define (generate-bril-instrs dest expr)
+ (match expr
+  [(Int n) 
+   (list (bril:ConstantInstr dest (bril:Type 'int) n))]
+  [(Prim '+ (list (Var v1) (Var v2))) 
+   (list (bril:ValueInstr 'add dest (bril:Type 'int)
+                         (list (symbol->string v1)
+                               (symbol->string v2))
+                         '() '()))]
+  [(Prim '- (list (Var v1))) 
+   (list (bril:ConstantInstr dest (bril:Type 'int) 0)
+         (bril:ValueInstr 'sub dest (bril:Type 'int)
+                          (list dest
+                                (symbol->string v1))
+                          '() '()))]))

cvar.rkt

@@ -0,0 +1,38 @@
+#lang racket
+
+(provide Int Prim Var Var-name Assign Seq Return CProgram interp-CVar% interp-CVar)
+
+(require "rvar.rkt")
+(require racket/dict)
+(require racket/struct)
+
+(struct CProgram (info labeled-seq) #:transparent)
+
+(struct Assign (var exp) #:transparent)
+(struct Seq (stmt tail) #:transparent)
+(struct Return (exp) #:transparent)
+
+(define interp-CVar%
+    (class interp-RVar-class
+       (super-new)
+           
+       (define/public ((interp-stmt env) stmt)
+         (match stmt
+           [(Assign (Var varname) exp)
+            (let ([val ((send this interp-exp env) exp)])
+                 (dict-set! env varname val))]))
+
+       (define/public ((interp-seq env) seq)
+         (match seq
+           [(Seq stmt tail)
+            (begin
+             ((interp-stmt env) stmt)
+             ((interp-seq env) tail))]
+           [(Return exp) ((send this interp-exp env) exp)]))
+
+       (define/public (interp-cprogram program)
+          (match program
+            [(CProgram _ labeled-seq) ((interp-seq (make-hash)) (cdar labeled-seq))]))))
+
+(define (interp-CVar program)
+  (send (new interp-CVar%) interp-cprogram program))

explicate-control.rkt

@@ -1,29 +1,29 @@
 #lang racket
 
-(require racket/fixnum)
-
 (provide explicate-control)
 
-(define (explicate-control sexp)
+(require racket/fixnum)
-  (match sexp
+(require "rvar.rkt")
-    [`(program ,info ,exp)
+(require "cvar.rkt")
-      `(program ,info ((start . ,(explicate-control-tail exp))))]))
+
+(define (explicate-control program)
+  (match program
+    [(Program info body)
+     (CProgram info (list `(start . ,(explicate-control-tail body))))]))
 
 ; after a remove-complex-opera*, all expressions
-; are compatible with C0
+; are in monadic normal form
 (define (explicate-control-tail exp)
   (match exp
-    [(? fixnum?) `(return ,exp)]
+    [(Int _) (Return exp)]
-    [(? symbol?) `(return ,exp)]
+    [(Var _) (Return exp)]
-    [`(read) `(return ,exp)]
+    [(Prim _ _) (Return exp)]
-    [`(- ,e) `(return ,exp)]
+    [(Let varname rexp body)
-    [`(+ ,e1 ,e2) `(return ,exp)]
+     (explicate-control-assign varname rexp (explicate-control-tail body))]))
-    [`(let ([,var ,rexp]) ,body)
-     (explicate-control-assign var rexp (explicate-control-tail body))]))
 
 ; stmt :=  (assign var exp)
 ; tail :=  (return exp) / (seq stmt tail)
-(define (explicate-control-assign var exp c0-body) `()
+(define (explicate-control-assign varname exp cvar-body)
   (match exp
-     [`(let ([,v ,x]) ,b) (explicate-control-assign v x (explicate-control-assign var b c0-body))]
+     [(Let v x b) (explicate-control-assign v x (explicate-control-assign varname b cvar-body))]
-     [_ `(seq (assign ,var ,exp) ,c0-body)]))
+     [_ (Seq (Assign (Var varname) exp) cvar-body)]))

remove-complex-oper.rkt

@@ -1,7 +1,7 @@
 #lang racket
 
 ; converts the program in monadic normal form
-(provide remove-complex-opera*)
+(provide remove-complex-opera* remove-complex-opera*-2)
 
 (require "rvar.rkt")
 
@@ -32,6 +32,17 @@
 (define (get-unique-symbol tmpcount)
   (string->symbol (format "tmp.~a" tmpcount)))
 
+; assoc-list: '((var-symbol exp) ...)
+; returns exp wrapped in a cascade of Let expressions that
+; uses the assoc-list as bindings
+(define (wrap-associations assoc-list exp)
+  (if (empty? assoc-list)
+    exp
+    (let ([binding (car assoc-list)])
+      (Let (car binding)
+           (cadr binding)
+           (wrap-associations (cdr assoc-list) exp)))))
+
 ; remove complex sub-expression 
 ; Transform the program into monadic normal form
 ; the resulting code is either
@@ -44,7 +55,7 @@
 ; - (+ x y) where x and y are atoms
 ; - (let ([var y]) z) where y and z are expressions
 ; this is achieved by introducing temporary variables when needed
-; if (let ([var y]) z) only allowed y to be an atom, this would be called
+; if (let ([var y]) z) only allowed z to be an atom, this would be called
 ; ANF (administrative normal form)
 (define (remove-complex-opera* p)
   (match p 
@@ -54,20 +65,9 @@
        (define-values (new-exp dis) (rco-exp body-exp initial-tmpcount))
        (Program info new-exp))]))
 
-; assoc-list: '((var-symbol exp) ...)
-; returns exp wrapped in a cascade of Let expressions that
-; uses the assoc-list as bindings
-(define (wrap-associations assoc-list exp)
-  (if (empty? assoc-list)
-    exp
-    (let ([binding (car assoc-list)])
-      (Let (car binding)
-           (cadr binding)
-           (wrap-associations (cdr assoc-list) exp)))))
-
 ; rco-exp
 ; returns-values:
-; - exp in ANF
+; - exp in MNF
 ; - the temporary var count reached
 (define (rco-exp exp tmpcount)
   (match exp
@@ -92,11 +92,11 @@
       (define-values (exp-tmp exp-tmpcount) (rco-exp e tmpcount))
       (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
       (values (Let var exp-tmp new-body)
-              exp-tmpcount))]))
+              new-tmpcount))]))
 
 ; rco-arg
 ; returns-values: 
-; new-exp (atom ANF expression)
+; new-exp (atom MNF expression)
 ; association list used to evaluate atom new-exp
 ; tmpcount reached after having created the new association list and the new temporaries
 (define (rco-arg exp tmpcount)
@@ -130,3 +130,85 @@
      (values new-body
              (cons `(,var ,new-exp) assoc-list)
              new-tmpcount))]))
+
+; remove complex sub-expression 
+; 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
+; Integers cannot appear naked if not in a binding
+(define (remove-complex-opera*-2 p)
+  (match p 
+    [(Program info body-exp)
+     (begin
+       (define initial-tmpcount (find-tmp-last-exp body-exp))
+       (define-values (new-exp assoc-list tmpcount) (rco-arg-2 body-exp initial-tmpcount))
+       (Program info (wrap-associations assoc-list new-exp)))]))
+
+; rco-arg
+; returns-values: 
+; new-exp (atom ANF expression)
+; association list used to evaluate atom new-exp
+; tmpcount reached after having created the new association list and the new temporaries
+(define (rco-arg-2 exp tmpcount)
+  (match exp
+   [(Var _) (values exp '() tmpcount)]
+   [(Int n) 
+    (begin
+     (define inc-tmpcount (+ tmpcount 1))
+     (define tmpname (get-unique-symbol inc-tmpcount))
+     (values (Var tmpname)
+             `((,tmpname ,exp))
+             inc-tmpcount))]
+   [(Prim op args)
+    (begin
+     (define-values (new-args assoc-list new-tmpcount)
+                    (for/fold ([cur-args '()]
+                               [cur-assoc-list '()]
+                               [cur-tmpcount tmpcount])
+                              ([arg args])
+                     (begin
+                      (define-values (atom assoc-list tmpcount) (rco-arg-2 arg cur-tmpcount))
+                      (values (append cur-args (list atom))
+                              (append cur-assoc-list assoc-list)
+                              tmpcount))))
+     (define inc-tmpcount (+ new-tmpcount 1))
+     (define tmpname (get-unique-symbol inc-tmpcount))
+     (set! assoc-list (append assoc-list (list `(,tmpname ,(Prim op new-args)))))
+     (values (Var tmpname)
+             assoc-list
+             inc-tmpcount))]
+   ; this must return a simple term
+   ; i.e.: either a symbol or number literal
+   [(Let var rexp body)
+    (begin
+     (define-values (new-exp exp-tmpcount) (rco-exp-2 rexp tmpcount))
+     (define-values (new-body assoc-list new-tmpcount) (rco-arg-2 body exp-tmpcount))
+     (values new-body
+             (cons `(,var ,new-exp) assoc-list)
+             new-tmpcount))]))
+
+(define (rco-exp-2 exp tmpcount)
+ (match exp
+   [(Int _) (values exp tmpcount)]
+   [(Var _) (values exp tmpcount)]
+   [(Prim op args)
+    (begin
+     (define-values (new-args assoc-list new-tmpcount)
+                    (for/fold ([cur-args '()]
+                               [cur-assoc-list '()]
+                               [cur-tmpcount tmpcount])
+                              ([arg args])
+                     (begin
+                      (define-values (atom assoc-list tmpcount) (rco-arg-2 arg cur-tmpcount))
+                      (values (append cur-args (list atom))
+                              (append cur-assoc-list assoc-list)
+                              tmpcount))))
+     (values (wrap-associations assoc-list (Prim op new-args)) new-tmpcount))]
+                               
+   [(Let var e body)
+    (begin
+     (define-values (exp-tmp exp-tmpcount) (rco-exp-2 e tmpcount))
+     (define-values (new-body new-tmpcount) (rco-exp-2 body exp-tmpcount))
+     (values (Let var exp-tmp new-body)
+             new-tmpcount))]))

rvar.rkt

@@ -1,11 +1,11 @@
 #lang racket
 
+(provide Int Prim Var Var-name Let Program interp-RVar-class interp-RVar)
+
 (require racket/fixnum)
 (require racket/dict)
 (require racket/struct)
 
-(provide Int Prim Var Let Program interp-RVar-class interp-RVar)
-
 (struct Int (value) #:transparent)
 (struct Var (name) #:transparent)
 (struct Prim (op args) #:transparent)

test-cvar-to-bril.rkt

@@ -0,0 +1,24 @@
+#lang racket
+
+(require "test-util.rkt")
+(require "cvar-to-bril.rkt")
+(require "uniquify.rkt")
+(require "remove-complex-oper.rkt")
+(require "explicate-control.rkt")
+(require "rvar.rkt")
+(require bril/interpreter)
+
+(define listings 
+ (list
+  (Program '() (Prim '+ (list (Int 1) (Int 2))))))
+
+(define (evaluate-bril-main bril-program)
+  (cadr (interp-bril bril-program "main")))
+
+(define (pass program)
+  (cvar-to-bril (explicate-control (remove-complex-opera*-2 (uniquify program)))))
+
+(for ([program listings])
+ (test-eq (interp-RVar (list-ref listings 0))
+          (evaluate-bril-main (pass (list-ref listings 0)))))
+

test-cvar.rkt

@@ -0,0 +1,39 @@
+#lang racket
+
+(require "test-util.rkt")
+(require "cvar.rkt")
+
+(define seq-1
+    (Return (Int 0)))
+
+(define seq-2
+    (Seq (Assign (Var 'x) (Int 42))
+     (Return (Int 42))))
+
+(define seq-3
+    (Seq (Assign (Var 'x) (Int 42))
+     (Return (Prim '+ (list (Int 1) (Var 'x))))))
+
+(define seq-4
+    (Return (Prim 'read '())))
+
+(define (make-start-seq seq)
+    (CProgram '() `((start . ,seq))))
+
+(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-explicate-control.rkt

@@ -1,62 +1,82 @@
 #lang racket
 
 (require "test-util.rkt")
+(require "uniquify.rkt")
 (require "remove-complex-oper.rkt")
 (require "explicate-control.rkt")
-(require "c2.rkt")
+(require "rvar.rkt")
+(require "cvar.rkt")
 
 (define programs
   (list
-   `(program () (+ 2 3))
+   (Program '() (Prim '+ (list (Int 2) (Int 3))))
-   `(program () (+ (- 2) 3))
+   (Program '() (Prim '+ (list (Prim '- (list (Int 2))) (Int 3))))
-   `(program ()
+   (Program '()
-             (let ([y (let ([x 20])
+            (Let 'y (Let 'x (Int 20)
-                        (+ x (let ([x 22]) x)))]) y))
+                         (Prim '+ (list (Var 'x) (Let 'x (Int 22) (Var 'x)))))
-   `(program ()
+                    (Var 'y)))
-      (let ([a 42])
+   (Program '()
-        (let ([b a])
+    (Let 'a (Int 42)
-          b)))
+         (Let 'b (Var 'a)
+              (Var 'b))))
 
-   `(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5)))))
+   (Program '()
+    (Prim '+ (list (Let 'x (Prim '+ (list (Prim '- (list (Int 1))) (Int 2)))
+                       (Prim '+ (list (Var 'x) (Int 2))))
+                   (Prim '+ (list (Int 4) (Int 5))))))))
 
-(define (pass program) (explicate-control (remove-complex-opera* program)))
+(define (pass program) (explicate-control (remove-complex-opera* (uniquify program))))
+(define (pass-2 program) (explicate-control (remove-complex-opera*-2 (uniquify program))))
 
 (test-eq
  (pass (list-ref programs 0))
- `(program ()
+ (CProgram '()
-           ((start .
+           (list `(start .
-             (return (+ 2 3))))))
+                   ,(Return (Prim '+ (list (Int 2) (Int 3))))))))
+
+(test-eq
+ (pass-2 (list-ref programs 0))
+ (CProgram '()
+           (list `(start .
+                   ,(Seq (Assign (Var 'tmp.0) (Int 2))
+                     (Seq (Assign (Var 'tmp.1) (Int 3))
+                      (Seq (Assign (Var 'tmp.2) (Prim '+ (list (Var 'tmp.0) (Var 'tmp.1))))
+                       (Return (Var 'tmp.2)))))))))
 
 (test-eq
  (pass (list-ref programs 1))
- `(program ()
+ (CProgram '()
-           ((start .
+           (list `(start .
-             (seq (assign tmp.1 (- 2))
+                   ,(Seq (Assign (Var 'tmp.0) (Prim '- (list (Int 2))))
-              (return (+ tmp.1 3)))))))
+                     (Return (Prim '+ (list (Var 'tmp.0) (Int 3)))))))))
 
 (test-eq
   (pass (list-ref programs 2))
-  `(program ()
+  (CProgram '()
-            ((start .
+           `((start .
-              (seq (assign x.1 20)
+              ,(Seq (Assign (Var 'x.1) (Int 20))
-               (seq (assign x.2 22)
+                (Seq (Assign (Var 'x.2) (Int 22))
-                (seq (assign y.1 (+ x.1 x.2))
+                 (Seq (Assign (Var 'y.1) (Prim '+ (list (Var 'x.1) (Var 'x.2))))
-                 (return y.1))))))))
+                  (Return (Var 'y.1)))))))))
 
 (test-eq
  (pass (list-ref programs 3))
- `(program ()
+ (CProgram '()
-           ((start .
+          `((start .
-             (seq (assign a.1 42)
+             ,(Seq (Assign (Var 'a.1) (Int 42))
-                  (seq (assign b.1 a.1)
+               (Seq (Assign (Var 'b.1) (Var 'a.1))
-                       (return b.1)))))))
+                (Return (Var 'b.1))))))))
 
 (test-eq
  (pass (list-ref programs 4))
- `(program ()
+ (CProgram '()
-           ((start .
+           `((start .
-             (seq (assign tmp.1 (- 1))
+              ,(Seq (Assign (Var 'tmp.0) (Prim '- (list (Int 1))))
-                  (seq (assign x.1 (+ tmp.1 2))
+                (Seq (Assign (Var 'x.1) (Prim '+ (list (Var 'tmp.0) (Int 2))))
-                       (seq (assign tmp.2 (+ x.1 2))
+                 (Seq (Assign (Var 'tmp.1) (Prim '+ (list (Var 'x.1) (Int 2))))
-                            (seq (assign tmp.3 (+ 4 5))
+                  (Seq (Assign (Var 'tmp.2) (Prim '+ (list (Int 4) (Int 5))))
-                                 (return (+ tmp.2 tmp.3))))))))))
+                   (Return (Prim '+ (list (Var 'tmp.1) (Var 'tmp.2))))))))))))
+
+(for ([program programs])
+  (test-eq (interp-RVar program)
+           (interp-CVar (pass program))))

test-remove-complex-opera.rkt

@@ -74,21 +74,57 @@
                            (Let 'x (Int 2)
                                 (Var 'x)))))))
 
-(define inputs
-    (let ([empty-inputs (build-list (length programs) (lambda (_) '()))])
-      (list-set empty-inputs 13 '(2 3))))
-
-(define (pass p)
-    (remove-complex-opera* (uniquify p)))
-
 (begin
  (define-values (a b c) (rco-arg (Prim '- (list (Int 20))) -1))
  (test-eq a (Var 'tmp.0)))
 
+(define (pass p)
+    (remove-complex-opera* (uniquify p)))
+
+(define (pass-2 p)
+    (remove-complex-opera*-2 (uniquify p)))
+
+(test-eq
+ (pass-2 (Program '() (Int 20)))
+ (Program '() (Let 'tmp.0 (Int 20) (Var 'tmp.0))))
+
+(test-eq
+ (pass-2 (Program '() (Let 'x (Int 20) (Var 'x))))
+ (Program '() (Let 'x.1 (Int 20) (Var 'x.1))))
+
+(test-eq
+ (pass-2 (Program '() (Let 'x (Int 20) (Int 40))))
+ (Program '() (Let 'x.1 (Int 20) (Let 'tmp.0 (Int 40) (Var 'tmp.0)))))
+
+(test-eq
+ (pass-2 (Program '() (Let 'x (Int 20) (Let 'y (Int 40) (Prim '+ (list (Var 'y) (Int 1)))))))
+ (Program '() (Let 'x.1 (Int 20) 
+                   (Let 'y.1 (Int 40) 
+                        (Let 'tmp.0 (Int 1)
+                             (Let 'tmp.1 (Prim '+ (list (Var 'y.1) (Var 'tmp.0)))
+                                  (Var 'tmp.1)))))))
+(test-eq
+ (pass-2 (Program '() (Let 'x (Let 'y (Int 40) (Prim '+ (list (Var 'y) (Int 1)))) (Var 'x))))
+ (Program '() (Let 'x.1 (Let 'y.1 (Int 40) 
+                             (Let 'tmp.0 (Int 1)
+                                  (Prim '+ (list (Var 'y.1) (Var 'tmp.0)))))
+                   (Var 'x.1))))
+(test-eq
+ (pass-2 (list-ref programs 0))
+ (Program '() (Let 'tmp.0 (Int 20) (Let 'tmp.1 (Prim '- (list (Var 'tmp.0))) (Var 'tmp.1)))))
+
+(define inputs
+   (let ([empty-inputs (build-list (length programs) (lambda (_) '()))])
+     (list-set empty-inputs 13 '(2 3))))
+
 (for ([program programs]
       [input-list inputs])
+ (begin
   (test-eq (with-input-from-num-list input-list
                (lambda () (interp-RVar program)))
            (with-input-from-num-list input-list
-               (lambda () (interp-RVar (pass program))))))
+               (lambda () (interp-RVar (pass program)))))
-
+  (test-eq (with-input-from-num-list input-list
+               (lambda () (interp-RVar program)))
+           (with-input-from-num-list input-list
+               (lambda () (interp-RVar (pass-2 program)))))))