Rewrite explicate-control

This commit is contained in:
Enrico Lumetti 2022-05-01 16:09:35 +02:00
parent 0929ef05f9
commit 3851d496ed
2 changed files with 64 additions and 54 deletions

View File

@ -1,29 +1,29 @@
#lang racket
(require racket/fixnum)
(provide explicate-control)
(define (explicate-control sexp)
(match sexp
[`(program ,info ,exp)
`(program ,info ((start . ,(explicate-control-tail exp))))]))
(require racket/fixnum)
(require "rvar.rkt")
(require "cvar.rkt")
(define (explicate-control program)
(match program
[(Program info body)
(CProgram info (list `(start . ,(explicate-control-tail body))))]))
; after a remove-complex-opera*, all expressions
; are compatible with C0
; are in monadic normal form
(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))]))
[(Int _) (Return exp)]
[(Var _) (Return exp)]
[(Prim _ _) (Return exp)]
[(Let varname rexp body)
(explicate-control-assign varname rexp (explicate-control-tail body))]))
; stmt := (assign var exp)
; tail := (return exp) / (seq stmt tail)
(define (explicate-control-assign var exp c0-body) `()
(define (explicate-control-assign varname exp cvar-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)]))
[(Let v x b) (explicate-control-assign v x (explicate-control-assign varname b cvar-body))]
[_ (Seq (Assign (Var varname) exp) cvar-body)]))

View File

@ -1,62 +1,72 @@
#lang racket
(require "test-util.rkt")
(require "uniquify.rkt")
(require "remove-complex-oper.rkt")
(require "explicate-control.rkt")
(require "c2.rkt")
(require "rvar.rkt")
(require "cvar.rkt")
(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 '() (Prim '+ (list (Int 2) (Int 3))))
(Program '() (Prim '+ (list (Prim '- (list (Int 2))) (Int 3))))
(Program '()
(Let 'y (Let 'x (Int 20)
(Prim '+ (list (Var 'x) (Let 'x (Int 22) (Var 'x)))))
(Var 'y)))
(Program '()
(Let 'a (Int 42)
(Let 'b (Var 'a)
(Var 'b))))
`(program () (+ (let ([x (+ (- 1) 2)]) (+ x 2)) (+ 4 5)))))
(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))))))))
(define (pass program) (explicate-control (remove-complex-opera* program)))
(define (pass program) (explicate-control (remove-complex-opera* (uniquify program))))
(test-eq
(pass (list-ref programs 0))
`(program ()
((start .
(return (+ 2 3))))))
(CProgram '()
(list `(start .
,(Return (Prim '+ (list (Int 2) (Int 3))))))))
(test-eq
(pass (list-ref programs 1))
`(program ()
((start .
(seq (assign tmp.1 (- 2))
(return (+ tmp.1 3)))))))
(CProgram '()
(list `(start .
,(Seq (Assign (Var 'tmp.0) (Prim '- (list (Int 2))))
(Return (Prim '+ (list (Var 'tmp.0) (Int 3)))))))))
(test-eq
(pass (list-ref programs 2))
`(program ()
((start .
(seq (assign x.1 20)
(seq (assign x.2 22)
(seq (assign y.1 (+ x.1 x.2))
(return y.1))))))))
(CProgram '()
`((start .
,(Seq (Assign (Var 'x.1) (Int 20))
(Seq (Assign (Var 'x.2) (Int 22))
(Seq (Assign (Var 'y.1) (Prim '+ (list (Var 'x.1) (Var 'x.2))))
(Return (Var 'y.1)))))))))
(test-eq
(pass (list-ref programs 3))
`(program ()
((start .
(seq (assign a.1 42)
(seq (assign b.1 a.1)
(return b.1)))))))
(CProgram '()
`((start .
,(Seq (Assign (Var 'a.1) (Int 42))
(Seq (Assign (Var 'b.1) (Var 'a.1))
(Return (Var 'b.1))))))))
(test-eq
(pass (list-ref programs 4))
`(program ()
((start .
(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))))))))))
(CProgram '()
`((start .
,(Seq (Assign (Var 'tmp.0) (Prim '- (list (Int 1))))
(Seq (Assign (Var 'x.1) (Prim '+ (list (Var 'tmp.0) (Int 2))))
(Seq (Assign (Var 'tmp.1) (Prim '+ (list (Var 'x.1) (Int 2))))
(Seq (Assign (Var 'tmp.2) (Prim '+ (list (Int 4) (Int 5))))
(Return (Prim '+ (list (Var 'tmp.1) (Var 'tmp.2))))))))))))
(for ([program programs])
(test-eq (interp-RVar program)
(interp-CVar (pass program))))