Convert remove-complex-opera* to new data structures

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
+(require "rvar.rkt")
-; 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))])))
 
-(define (let-binding var val exp)
+; find number of the last variable named tmp.n
-  `(let ([,var ,val]) ,exp))
+(define (find-tmp-last p)
+  (match p
+    [(Program _ body) (find-tmp-last-exp body)]))
 
-(define (wrap-associations assoc-list exp)
+(define (find-tmp-last-exp p)
-  (if (empty? assoc-list)
+  (match p
-    exp
+    [(Let sym rexp body)
-    (let ([binding (car assoc-list)])
+     (let ([tmp-max-rexp (find-tmp-last-exp rexp)]
-      (let-binding (car binding) (cadr binding)
+           [tmp-max-body (find-tmp-last-exp body)])
-                   (wrap-associations (cdr assoc-list) exp)))))
+      (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)
+(define (is-tmp-var sym)
-  (match exp
+    (let ([ssym (symbol->string sym)])
-    [(? fixnum?) (values exp tmpcount)]
+         (and (string-prefix? ssym "tmp.")
-    [(? symbol?) (values exp tmpcount)]
+              (not (eq? #f (string->number (substring ssym 4)))))))
-    [`(read) (values exp tmpcount)]
+
-    [`(- ,e)
+(define (get-tmp-num sym)
-     (begin
+  (string->number (substring (symbol->string sym) 4)))
-      (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 (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)]
+   [(Int _) (values exp '() tmpcount)]
-   [(? symbol?) (values exp '() tmpcount)]
+   [(Var _) (values exp '() tmpcount)]
-   [`(read)
+   [(Prim op args)
     (begin
-      (define new-tmpcount (+ tmpcount 1))
+     (define-values (new-args assoc-list new-tmpcount)
-      (define tmpname (get-unique-symbol new-tmpcount))
+                    (for/fold ([cur-args '()]
-      (values tmpname
+                               [cur-assoc-list '()]
-              (list `(,tmpname (read)))
+                               [cur-tmpcount tmpcount])
-              new-tmpcount))]
+                              ([arg args])
-   [`(- ,e)
+                     (begin
-    (begin
+                      (define-values (atom assoc-list tmpcount) (rco-arg arg cur-tmpcount))
-     (define-values (new-exp assoc-list exp-tmpcount) (rco-arg e tmpcount))
+                      (values (append cur-args (list atom))
-     (define new-tmpcount (+ exp-tmpcount 1))
+                              (append cur-assoc-list assoc-list)
-     (define tmpname (get-unique-symbol new-tmpcount))
+                              tmpcount))))
-     (set! assoc-list (append assoc-list (list `(,tmpname (- ,new-exp)))))
+     (define inc-tmpcount (+ new-tmpcount 1))
-     (values tmpname
+     (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))]
+             inc-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))]
    ; this must return a simple term
-   ; i.e.: either a symbol, a read or a number literal
+   ; i.e.: either a symbol or number literal
-   [`(let ([,var ,rexp]) ,body)
+   [(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))

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

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 ()
+   (Program '()
-             (- 20))
+            (Prim '- (list (Int 20))))
-   `(program ()
+   (Program '()
-             (- (- 20)))
+            (Prim '- (list (Prim '- (list (Int 20))))))
-   `(program ()
+   (Program '()
-             (- (- (- 20))))
+            (Prim '- (list (Prim '- (list (Prim '- (list (Int 20))))))))
-   `(program () (+ 3 (- 20)))
+   (Program '() (Prim '+ (list (Int 3) (Prim '- (list (Int 20))))))
-   `(program () (+ (+ 3 2) (+ 4 5)))
+   (Program '() 
-   `(program () (let ([x 1]) x))
+            (Prim '+ (list (Prim '+ (list (Int 3) (Int 2)))
-   `(program () (let ([x (+ (- 2) 3)]) (+ x (+ 2 3))))
+                           (Prim '+ (list (Int 4) (Int 5))))))
-   `(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5)))
+   (Program '() (Let 'x (Int 1) (Var 'x)))
-   `(program ()
+   (Program '() (Let 'x (Prim '+ (list (Prim '- (list (Int 2))) 
-      (let ([a 42])
+                                       (Int 3)))
-        (let ([b a])
+                        (Prim '+ (list (Var 'x) 
-          b)))
+                                       (Prim '+ (list (Int 2) (Int 3)))))))
-   `(program () (let ([tmp (- 1)]) tmp))
+   (Program '() (Prim '+ 
-   `(program () (- (let ([x 1]) x)))
+                      (list (Let 'x 
-   `(program () (let ([x (let ([x 1]) x)]) (+ 2 x)))
+                                 (Prim '+ 
-   `(program ()
+                                       (list (Prim '- (list (Int 1)))
-             (let ([y (let ([x 20])
+                                             (Int 2)))
-                        (+ x (let ([x 22]) x)))]) y))
+                                 (Prim '+ (list (Var 'x) (Int 2))))
-   `(program ()
+                            (Prim '+ (list (Int 4) (Int 5))))))
-             (+ (read) (read)))))
+   (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 (_) ""))])
+    (let ([empty-inputs (build-list (length programs) (lambda (_) '()))])
-      (list-set empty-inputs 13 "2\n3")))
+      (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-list inputs])
-      [input-string inputs])
+  (test-eq (with-input-from-num-list input-list
-  (test-eq (with-input-from-string input-string
+               (lambda () (interp-RVar program)))
-               (lambda () ((interp-R1 env) program)))
+           (with-input-from-num-list input-list
-           (with-input-from-string input-string
+               (lambda () (interp-RVar (pass program))))))
-               (lambda () ((interp-R1 env) (remove-complex-opera* 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)))))

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