Implement and test explicate-control

explicate-control.scm

@@ -0,0 +1,32 @@
+#lang racket
+
+(require racket/fixnum)
+
+(provide explicate-control)
+
+(define (explicate-control sexp)
+  (match sexp
+    [`(program ,info ,exp)
+      `(program ,info ,(explicate-control-tail exp))]))
+
+; after a remove-complex-opera*, all expressions
+; are compatible with C0
+(define (explicate-control-tail exp)
+  (match exp
+    [(? fixnum?) `(return ,exp)]
+    [(? symbol?) `(return ,exp)]
+    [`(read) `(return ,exp)]
+    [`(- ,e) `(return ,exp)]
+    [`(+ ,e1 ,e2) `(return ,exp)]
+    [`(let ([,var ,rexp]) ,body)
+     (explicate-control-assign var rexp (explicate-control-tail body))]))
+
+; stmt :=  (assign var exp)
+; tail :=  (return exp) / (seq stmt tail)
+(define (explicate-control-assign var exp c0-body) `()
+  (match exp
+     [`(let ([,v ,x]) ,b) (explicate-control-assign v x (explicate-control-assign var b c0-body))]
+     [_ `(seq (assign ,var ,exp) ,c0-body)]))
+
+
+

remove-complex-oper.scm

@@ -4,6 +4,15 @@
 
 (provide remove-complex-opera*)
 
+; remove complex sub-expression
+; the resulting code is either
+; - (read)
+; - a number literal
+; - a symbol
+; the three above are called in the following "simple terms"
+; - (- 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)
@@ -40,19 +49,15 @@
       (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))
+     (begin
+      (define-values (exp-tmp exp-tmpcount) (rco-exp e tmpcount))
       (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
-      (values (wrap-associations assoc-list
+      (values `(let ([,var ,exp-tmp]) ,new-body)
-                                 `(let ([,var ,new-exp]) ,new-body)) new-tmpcount)]))
+              exp-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)]
@@ -60,33 +65,31 @@
    [`(read) (values exp '() tmpcount)]
    [`(- ,e)
     (begin
-     (define-values (new-exp exp-tmpcount) (rco-exp e tmpcount))
+     (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
-             `((,tmpname (- ,new-exp)))
+             assoc-list
              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-exp1 assoc-1 exp1-tmpcount) (rco-arg e1 tmpcount))
-     (define-values (new-exp2 exp2-tmpcount) (rco-exp e2 exp1-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
-             `((,tmpname (,op ,new-exp1 ,new-exp2)))
+             assoc-list
              new-tmpcount))]
+   ; this must return a simple term
+   ; i.e.: either a symbol, a read or a number literal
    [`(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-values (new-body assoc-list new-tmpcount) (rco-arg body exp-tmpcount))
-     (define new-tmpcount (+ body-tmpcount 1))
+     (values new-body
-     (define tmpname (get-unique-symbol new-tmpcount))
+             (cons `(,var ,new-exp) assoc-list)
-     (values tmpname
-             `((,tmpname (let ([,var ,new-exp]) ,new-body)))
              new-tmpcount))]))
-     
-
-;(require racket/trace)
-;(trace rco-exp)
-;(trace rco-arg)

test-explicate-control.scm

@@ -0,0 +1,59 @@
+#lang racket
+
+(require "test-util.scm")
+(require "remove-complex-oper.scm")
+(require "explicate-control.scm")
+(require "c2.scm")
+
+(define programs 
+  (list
+   `(program () (+ 2 3))
+   `(program () (+ (- 2) 3))
+   `(program ()
+             (let ([y (let ([x 20])
+                        (+ x (let ([x 22]) x)))]) y))
+   `(program ()
+      (let ([a 42])
+        (let ([b a])
+          b)))
+
+   `(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5)))))
+
+      
+
+(define (pass program) (explicate-control (remove-complex-opera* program)))
+
+(test-eq
+ (pass (list-ref programs 0))
+ `(program ()
+           (return (+ 2 3))))
+
+(test-eq
+ (pass (list-ref programs 1))
+ `(program ()
+           (seq (assign tmp.1 (- 2))
+             (return (+ tmp.1 3)))))
+
+(test-eq
+  (pass (list-ref programs 2))
+  `(program ()
+     (seq (assign x.1 20)
+      (seq (assign x.2 22)
+       (seq (assign y.1 (+ x.1 x.2))
+        (return y.1))))))
+
+(test-eq
+ (pass (list-ref programs 3))
+ `(program ()
+           (seq (assign a.1 42)
+                (seq (assign b.1 a.1)
+                     (return b.1)))))
+
+(test-eq
+ (pass (list-ref programs 4))
+ `(program ()
+           (seq (assign tmp.1 (- 1)) 
+                (seq (assign x.1 (+ tmp.1 2)) 
+                     (seq (assign tmp.2 (+ x.1 2)) 
+                          (seq (assign tmp.3 (+ 4 5)) 
+                               (return (+ tmp.2 tmp.3))))))))

test-remove-complex-opera.scm

@@ -8,15 +8,29 @@
   (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 ([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))))
+
+(for/list ([program programs] [env (build-list (length programs) (lambda (_) '()))])
+     (test-eq ((interp-R1 env) program)
+              ((interp-R1 env) (remove-complex-opera* program))))
 
 (test-eq
   (remove-complex-opera* (list-ref programs 0))
@@ -24,39 +38,62 @@
 
 (test-eq
   (remove-complex-opera* (list-ref programs 1))
-  `(program () (let ((tmp.1 (- 20))) (+ 3 tmp.1))))
+  `(program () (let ([tmp.1 (- 20)]) (- 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)))))
+  `(program () (let ([tmp.1 (- 20)]) (let ([tmp.2 (- tmp.1)]) (- tmp.2)))))
 
 (test-eq
   (remove-complex-opera* (list-ref programs 3))
-  `(program () 
+  `(program () (let ((tmp.1 (- 20))) (+ 3 tmp.1))))
-            (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 ()
+  `(program () (let ((tmp.1 (+ 3 2))) (let ((tmp.2 (+ 4 5))) (+ tmp.1 tmp.2)))))
-            (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 ((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 6))
+  (remove-complex-opera* (list-ref programs 9))
- `(program () (let ((tmp.2 (- 1))) (let ((tmp.1 tmp.2)) tmp.1))))
+ `(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)))
+                   
 
-(for/list ([program programs] [env (build-list (length programs) (lambda (_) '()))])
-     (test-eq ((interp-R1 env) program)
-              ((interp-R1 env) (remove-complex-opera* program))))