enrico
/
eoc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Introduce different remove-complex-opera* pass 

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.
This commit is contained in:
Enrico Lumetti 2022-05-01 22:46:36 +02:00
parent 3851d496ed
commit e3636d0b05
5 changed files with 155 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cvar.rkt
View File

@ -1,6 +1,6 @@
#lang racket
(provide Int Prim Var Assign Seq Return CProgram interp-CVar% interp-CVar)
(provide Int Prim Var Var-name Assign Seq Return CProgram interp-CVar% interp-CVar)
(require "rvar.rkt")
(require racket/dict)

114
remove-complex-oper.rkt
View File

@ -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))]))

2
rvar.rkt
View File

@ -1,6 +1,6 @@
#lang racket
(provide Int Prim Var Let Program interp-RVar-class interp-RVar)
(provide Int Prim Var Var-name Let Program interp-RVar-class interp-RVar)
(require racket/fixnum)
(require racket/dict)

10
test-explicate-control.rkt
View File

@ -26,6 +26,7 @@
(Prim '+ (list (Int 4) (Int 5))))))))
(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))
@ -33,6 +34,15 @@
(list `(start .
,(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))
(CProgram '()

54
test-remove-complex-opera.rkt
View File

@ -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)))))))