From 5b1f580ed8b2b8638aaffdb05be613603a451d9f Mon Sep 17 00:00:00 2001 From: Enrico Lumetti Date: Sat, 30 Apr 2022 18:01:54 +0200 Subject: [PATCH] Convert remove-complex-opera* to new data structures --- remove-complex-oper.rkt | 188 ++++++++++++++++++++-------------- rvar.rkt | 4 +- test-remove-complex-opera.rkt | 181 +++++++++++++++----------------- test-uniquify.rkt | 1 + 4 files changed, 195 insertions(+), 179 deletions(-) diff --git a/remove-complex-oper.rkt b/remove-complex-oper.rkt index b2dff9e..33463d3 100644 --- a/remove-complex-oper.rkt +++ b/remove-complex-oper.rkt @@ -1,97 +1,129 @@ #lang racket -(require "uniquify.rkt") - +; converts the program in monadic normal form (provide remove-complex-opera*) -; remove complex sub-expression -; the resulting code is either -; - a number literal -; - a symbol -; the three above are called in the following "simple terms" -; - (read) -; - (- x) where x is a simple term -; - (+ x y) where x and y are simple terms -; - (let ([var y]) z) where y and z are expressions -(define (remove-complex-opera* p) - (let ([uniq-res (uniquify p)]) - (match (cadr uniq-res) - [`(program ,data ,exp) - (begin - (define initial-tmpcount (hash-ref (car uniq-res) `tmp 0)) - (define-values (new-exp bla) (rco-exp exp initial-tmpcount)) - `(program ,data ,new-exp))]))) +(require "rvar.rkt") -(define (let-binding var val exp) - `(let ([,var ,val]) ,exp)) +; find number of the last variable named tmp.n +(define (find-tmp-last p) + (match p + [(Program _ body) (find-tmp-last-exp body)])) -(define (wrap-associations assoc-list exp) - (if (empty? assoc-list) - exp - (let ([binding (car assoc-list)]) - (let-binding (car binding) (cadr binding) - (wrap-associations (cdr assoc-list) exp))))) +(define (find-tmp-last-exp p) + (match p + [(Let sym rexp body) + (let ([tmp-max-rexp (find-tmp-last-exp rexp)] + [tmp-max-body (find-tmp-last-exp body)]) + (if (is-tmp-var sym) + (max (get-tmp-num sym) (max tmp-max-rexp tmp-max-body)) + (max tmp-max-rexp tmp-max-body)))] + [(Prim _ args) (apply max (cons -1 (map find-tmp-last-exp args)))] + [_ -1])) -(define (rco-exp exp tmpcount) - (match exp - [(? fixnum?) (values exp tmpcount)] - [(? symbol?) (values exp tmpcount)] - [`(read) (values exp tmpcount)] - [`(- ,e) - (begin - (define-values (new-exp assoc-list new-tmpcount) (rco-arg e tmpcount)) - (values (wrap-associations assoc-list `(- ,new-exp)) new-tmpcount))] - [`(+ ,e1 ,e2) - (begin - (define-values (new-exp1 assoc-list1 new-tmpcount1) (rco-arg e1 tmpcount)) - (define-values (new-exp2 assoc-list2 new-tmpcount) (rco-arg e2 new-tmpcount1)) - (values (wrap-associations (append assoc-list1 assoc-list2) - `(+ ,new-exp1 ,new-exp2)) new-tmpcount))] - [`(let ([,var ,e]) ,body) - (begin - (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))])) +(define (is-tmp-var sym) + (let ([ssym (symbol->string sym)]) + (and (string-prefix? ssym "tmp.") + (not (eq? #f (string->number (substring ssym 4))))))) + +(define (get-tmp-num sym) + (string->number (substring (symbol->string sym) 4))) (define (get-unique-symbol tmpcount) (string->symbol (format "tmp.~a" tmpcount))) +; remove complex sub-expression +; Transform the program into monadic normal form +; the resulting code is either +; "atoms", with no side effects +; - a integer literal +; - a variable +; complex expressions, which may have side effects: +; - (read) +; - (- x) where x is an atom +; - (+ 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 +; ANF (administrative normal form) +(define (remove-complex-opera* p) + (match p + [(Program info body-exp) + (begin + (define initial-tmpcount (find-tmp-last-exp body-exp)) + (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 +; - the temporary var count reached +(define (rco-exp 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 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 e tmpcount)) + (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount)) + (values (Let var exp-tmp new-body) + exp-tmpcount))])) + +; 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 exp tmpcount) (match exp - [(? fixnum?) (values exp '() tmpcount)] - [(? symbol?) (values exp '() tmpcount)] - [`(read) + [(Int _) (values exp '() tmpcount)] + [(Var _) (values exp '() tmpcount)] + [(Prim op args) (begin - (define new-tmpcount (+ tmpcount 1)) - (define tmpname (get-unique-symbol new-tmpcount)) - (values tmpname - (list `(,tmpname (read))) - new-tmpcount))] - [`(- ,e) - (begin - (define-values (new-exp assoc-list exp-tmpcount) (rco-arg e tmpcount)) - (define new-tmpcount (+ exp-tmpcount 1)) - (define tmpname (get-unique-symbol new-tmpcount)) - (set! assoc-list (append assoc-list (list `(,tmpname (- ,new-exp))))) - (values tmpname + (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 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 - new-tmpcount))] - [`(,op ,e1 ,e2) - #:when (or (eq? op `+) (eq? op `-)) - (begin - (define-values (new-exp1 assoc-1 exp1-tmpcount) (rco-arg e1 tmpcount)) - (define-values (new-exp2 assoc-2 exp2-tmpcount) (rco-arg e2 exp1-tmpcount)) - (define assoc-list (append assoc-1 assoc-2)) - (define new-tmpcount (+ exp2-tmpcount 1)) - (define tmpname (get-unique-symbol new-tmpcount)) - (set! assoc-list (append assoc-list (list `(,tmpname (,op ,new-exp1 ,new-exp2))))) - (values tmpname - assoc-list - new-tmpcount))] + inc-tmpcount))] ; this must return a simple term - ; i.e.: either a symbol, a read or a number literal - [`(let ([,var ,rexp]) ,body) + ; i.e.: either a symbol or number literal + [(Let var rexp body) (begin (define-values (new-exp exp-tmpcount) (rco-exp rexp tmpcount)) (define-values (new-body assoc-list new-tmpcount) (rco-arg body exp-tmpcount)) diff --git a/rvar.rkt b/rvar.rkt index 20581e1..94c5d82 100644 --- a/rvar.rkt +++ b/rvar.rkt @@ -7,7 +7,7 @@ (provide Int Prim Var Let Program interp-RVar-class interp-RVar) (struct Int (value) #:transparent) -(struct Var (var) #:transparent) +(struct Var (name) #:transparent) (struct Prim (op args) #:transparent) (struct Let (var expr body) #:transparent) @@ -20,7 +20,7 @@ (define/public ((interp-exp env) exp) (match exp [(Int n) n] - [(Var v) (eval-symbol env v)] + [(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))] diff --git a/test-remove-complex-opera.rkt b/test-remove-complex-opera.rkt index 7e372b8..bb9b412 100644 --- a/test-remove-complex-opera.rkt +++ b/test-remove-complex-opera.rkt @@ -1,111 +1,94 @@ #lang racket +(require rackunit) + (require "test-util.rkt") +(require "uniquify.rkt") (require "remove-complex-oper.rkt") -(require "c2.rkt") +(require/expose "remove-complex-oper.rkt" (find-tmp-last rco-exp rco-arg)) +(require "rvar.rkt") + +(test-eq + (find-tmp-last (Program '() + (Let 'tmp.0 (Let 'x (Int 20) + (Prim '+ (list (Var 'x) + (Let 'tmp.1 (Int 22) + (Var 'tmp.1))))) + (Var 'tmp.0)))) + 1) + +(test-eq + (find-tmp-last (Program '() + (Let 'tmp.x (Let 'x (Int 20) + (Prim '+ (list (Var 'x) + (Let 'tmp.y (Int 22) + (Var 'tmp.y))))) + (Var 'tmp.x)))) + -1) (define programs (list - `(program () - (- 20)) - `(program () - (- (- 20))) - `(program () - (- (- (- 20)))) - `(program () (+ 3 (- 20))) - `(program () (+ (+ 3 2) (+ 4 5))) - `(program () (let ([x 1]) x)) - `(program () (let ([x (+ (- 2) 3)]) (+ x (+ 2 3)))) - `(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5))) - `(program () - (let ([a 42]) - (let ([b a]) - b))) - `(program () (let ([tmp (- 1)]) tmp)) - `(program () (- (let ([x 1]) x))) - `(program () (let ([x (let ([x 1]) x)]) (+ 2 x))) - `(program () - (let ([y (let ([x 20]) - (+ x (let ([x 22]) x)))]) y)) - `(program () - (+ (read) (read))))) + (Program '() + (Prim '- (list (Int 20)))) + (Program '() + (Prim '- (list (Prim '- (list (Int 20)))))) + (Program '() + (Prim '- (list (Prim '- (list (Prim '- (list (Int 20)))))))) + (Program '() (Prim '+ (list (Int 3) (Prim '- (list (Int 20)))))) + (Program '() + (Prim '+ (list (Prim '+ (list (Int 3) (Int 2))) + (Prim '+ (list (Int 4) (Int 5)))))) + (Program '() (Let 'x (Int 1) (Var 'x))) + (Program '() (Let 'x (Prim '+ (list (Prim '- (list (Int 2))) + (Int 3))) + (Prim '+ (list (Var 'x) + (Prim '+ (list (Int 2) (Int 3))))))) + (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)))))) + (Program '() + (Let 'a (Int 42) + (Let 'b (Var 'a) + (Var 'b)))) + (Program '() (Let 'tmp (Prim '- (list (Int 1))) (Var 'tmp))) + (Program '() (Prim '- + (list (Let 'x (Int 1) (Var 'x))))) + (Program '() (Let 'x (Let 'x (Int 1) (Var 'x)) (Prim '+ (list (Int 2) (Var 'x))))) + (Program '() + (Let 'y (Let 'x (Int 20) + (Prim '+ (list (Var 'x) + (Let 'x (Int 22) (Var 'x))))) + (Var 'y))) + (Program '() ; - pos 13 + (Prim '+ (list (Prim 'read '()) + (Prim 'read '())))) + + (Program '() + (Prim '+ (list (Let 'x (Int 1) + (Let 'x (Int 2) + (Int 2))) + (Let 'x (Int 2) + (Var 'x))))))) (define inputs - (let ([empty-inputs (build-list (length programs) (lambda (_) ""))]) - (list-set empty-inputs 13 "2\n3"))) + (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))) (for ([program programs] - [env (build-list (length programs) (lambda (_) '()))] - [input-string inputs]) - (test-eq (with-input-from-string input-string - (lambda () ((interp-R1 env) program))) - (with-input-from-string input-string - (lambda () ((interp-R1 env) (remove-complex-opera* program)))))) + [input-list inputs]) + (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)))))) -(test-eq - (remove-complex-opera* (list-ref programs 0)) - `(program () (- 20))) - -(test-eq - (remove-complex-opera* (list-ref programs 1)) - `(program () (let ([tmp.1 (- 20)]) (- tmp.1)))) - -(test-eq - (remove-complex-opera* (list-ref programs 2)) - `(program () (let ([tmp.1 (- 20)]) (let ([tmp.2 (- tmp.1)]) (- tmp.2))))) - -(test-eq - (remove-complex-opera* (list-ref programs 3)) - `(program () (let ((tmp.1 (- 20))) (+ 3 tmp.1)))) - -(test-eq - (remove-complex-opera* (list-ref programs 4)) - `(program () (let ((tmp.1 (+ 3 2))) (let ((tmp.2 (+ 4 5))) (+ tmp.1 tmp.2))))) - -(test-eq - (remove-complex-opera* (list-ref programs 5)) - `(program () - (let ((x.1 1)) x.1))) - -(test-eq - (remove-complex-opera* (list-ref programs 6)) - `(program () - (let ((x.1 - (let ((tmp.1 (- 2))) - (+ tmp.1 3)))) - (let ((tmp.2 (+ 2 3))) - (+ x.1 tmp.2))))) - -(test-eq - (remove-complex-opera* (list-ref programs 7)) - `(program () - (let ((x.1 - (let ((tmp.1 (- 1))) - (+ tmp.1 2)))) - (let ((tmp.2 (+ x.1 2))) - (let ((tmp.3 (+ 4 5))) - (+ tmp.2 tmp.3)))))) - -(test-eq - (remove-complex-opera* (list-ref programs 8)) - `(program () (let([a.1 42]) (let ([b.1 a.1]) b.1)))) - -(test-eq - (remove-complex-opera* (list-ref programs 9)) - `(program () (let ([tmp.1 (- 1)]) tmp.1))) - -(test-eq - (remove-complex-opera* (list-ref programs 10)) - `(program () (let ((x.1 1)) (- x.1)))) - -(test-eq - (remove-complex-opera* (list-ref programs 11)) - `(program () (let ((x.1 (let ((x.2 1)) x.2))) (+ 2 x.1)))) - -(test-eq - (remove-complex-opera* (list-ref programs 12)) - `(program () (let ((y.1 (let ((x.1 20)) (let ((x.2 22)) (+ x.1 x.2))))) y.1))) - -(test-eq - (remove-complex-opera* (list-ref programs 13)) - `(program () (let ((tmp.1 (read))) (let ((tmp.2 (read))) (+ tmp.1 tmp.2))))) diff --git a/test-uniquify.rkt b/test-uniquify.rkt index 53cefb9..e578c13 100644 --- a/test-uniquify.rkt +++ b/test-uniquify.rkt @@ -7,6 +7,7 @@ (require "uniquify.rkt") (require/expose "uniquify.rkt" (uniquify-exp)) +; returns both the resulting symtable and the uniquified program (define (list-uniquify-exp symtable) (lambda (exp) (call-with-values (lambda () ((uniquify-exp symtable symtable) exp)) list)))