diff --git a/remove-complex-oper.scm b/remove-complex-oper.scm new file mode 100644 index 0000000..2ef3601 --- /dev/null +++ b/remove-complex-oper.scm @@ -0,0 +1,92 @@ +#lang racket + +(require "uniquify.scm") + +(provide remove-complex-opera*) + +(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))]))) + +(define (let-binding var val exp) + `(let ([,var ,val]) ,exp)) + +(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 (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))] + [`(,op ,e1 ,e2) + #:when (or (eq? op `+) (eq? op `-)) + (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) + `(,op ,new-exp1 ,new-exp2)) new-tmpcount))] + [`(let ([,var ,e]) ,body) + (define-values (new-exp assoc-list exp-tmpcount) (rco-arg e tmpcount)) + (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount)) + (values (wrap-associations assoc-list + `(let ([,var ,new-exp]) ,new-body)) new-tmpcount)])) + +(define (get-unique-symbol tmpcount) + (string->symbol (format "tmp.~a" tmpcount))) + +(define (let-unique-exp tmpcount value) + (let-binding (get-unique-symbol tmpcount) + exp + (get-unique-symbol tmpcount))) + +(define (rco-arg exp tmpcount) + (match exp + [(? fixnum?) (values exp '() tmpcount)] + [(? symbol?) (values exp '() tmpcount)] + [`(read) (values exp '() tmpcount)] + [`(- ,e) + (begin + (define-values (new-exp exp-tmpcount) (rco-exp e tmpcount)) + (define new-tmpcount (+ exp-tmpcount 1)) + (define tmpname (get-unique-symbol new-tmpcount)) + (values tmpname + `((,tmpname (- ,new-exp))) + new-tmpcount))] + [`(,op ,e1 ,e2) + #:when (or (eq? op `+) (eq? op `-)) + (begin + (define-values (new-exp1 exp1-tmpcount) (rco-exp e1 tmpcount)) + (define-values (new-exp2 exp2-tmpcount) (rco-exp e2 exp1-tmpcount)) + (define new-tmpcount (+ exp2-tmpcount 1)) + (define tmpname (get-unique-symbol new-tmpcount)) + (values tmpname + `((,tmpname (,op ,new-exp1 ,new-exp2))) + new-tmpcount))] + [`(let ([,var ,rexp]) ,body) + (begin + (define-values (new-exp exp-tmpcount) (rco-exp rexp tmpcount)) + (define-values (new-body body-tmpcount) (rco-exp body exp-tmpcount)) + (define new-tmpcount (+ body-tmpcount 1)) + (define tmpname (get-unique-symbol new-tmpcount)) + (values tmpname + `((,tmpname (let ([,var ,new-exp]) ,new-body))) + new-tmpcount))])) + + +;(require racket/trace) +;(trace rco-exp) +;(trace rco-arg) diff --git a/test-remove-complex-opera.scm b/test-remove-complex-opera.scm new file mode 100644 index 0000000..f56e4f7 --- /dev/null +++ b/test-remove-complex-opera.scm @@ -0,0 +1,62 @@ +#lang racket + +(require "test-util.scm") +(require "remove-complex-oper.scm") +(require "c2.scm") + +(define programs + (list + `(program () + (- 20)) + `(program () (+ 3 (- 20))) + `(program () (+ (+ 3 2) (+ 4 5))) + `(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)))) + +(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))) (+ 3 tmp.1)))) + +(test-eq + (remove-complex-opera* (list-ref programs 2)) + `(program () (let ((tmp.1 (+ 3 2))) (let ((tmp.2 (+ 4 5))) (+ tmp.1 tmp.2))))) + +(test-eq + (remove-complex-opera* (list-ref programs 3)) + `(program () + (let ((tmp.1 (+ (- 2) 3))) + (let ((x.1 tmp.1)) + (let ((tmp.2 (+ 2 3))) + (+ x.1 tmp.2)))))) + +(test-eq + (remove-complex-opera* (list-ref programs 4)) + `(program () + (let ((tmp.2 + (let ((x.1 + (let ((tmp.1 (- 1))) + (+ tmp.1 2)))) + (+ x.1 2)))) + (let ((tmp.3 (+ 4 5))) + (+ tmp.2 tmp.3))))) + +(test-eq + (remove-complex-opera* (list-ref programs 5)) + `(program () (let([a.1 42]) (let ([b.1 a.1]) b.1)))) + +(test-eq + (remove-complex-opera* (list-ref programs 6)) + `(program () (let ((tmp.2 (- 1))) (let ((tmp.1 tmp.2)) tmp.1)))) + +(for/list ([program programs] [env (build-list (length programs) (lambda (_) '()))]) + (test-eq ((interp-R1 env) program) + ((interp-R1 env) (remove-complex-opera* program))))