Add remove-complex-opera* implementation

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)

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