From e3636d0b0526a8a8d033b6ca1c8e4ca5799f44bd Mon Sep 17 00:00:00 2001 From: Enrico Lumetti Date: Sun, 1 May 2022 22:46:36 +0200 Subject: [PATCH] Introduce different remove-complex-opera* pass This pass only allows arguments to be variables. The resulting language is: let-expr := (Let symbol ) 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.rkt | 2 +- remove-complex-oper.rkt | 114 +++++++++++++++++++++++++++++----- rvar.rkt | 2 +- test-explicate-control.rkt | 10 +++ test-remove-complex-opera.rkt | 54 +++++++++++++--- 5 files changed, 155 insertions(+), 27 deletions(-) diff --git a/cvar.rkt b/cvar.rkt index 316e7ab..9638f74 100644 --- a/cvar.rkt +++ b/cvar.rkt @@ -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) diff --git a/remove-complex-oper.rkt b/remove-complex-oper.rkt index 33463d3..86ae092 100644 --- a/remove-complex-oper.rkt +++ b/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))])) diff --git a/rvar.rkt b/rvar.rkt index b144363..121d85d 100644 --- a/rvar.rkt +++ b/rvar.rkt @@ -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) diff --git a/test-explicate-control.rkt b/test-explicate-control.rkt index 7f65c78..c555290 100644 --- a/test-explicate-control.rkt +++ b/test-explicate-control.rkt @@ -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 '() diff --git a/test-remove-complex-opera.rkt b/test-remove-complex-opera.rkt index bb9b412..97f2a75 100644 --- a/test-remove-complex-opera.rkt +++ b/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)))))))