Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

[diderot] View of /branches/pure-cfg/src/compiler/simplify/simplify.sml
 [diderot] / branches / pure-cfg / src / compiler / simplify / simplify.sml # View of /branches/pure-cfg/src/compiler/simplify/simplify.sml

Mon Mar 14 14:10:52 2011 UTC (10 years, 2 months ago) by jhr
File size: 6662 byte(s)
```  Since initially only supports rectangular-shaped iteration, we can lift the range
computation outside the iterations.  This allows us to determine the dimensions and
to change the order of loop nesting.
```
```(* simplify.sml
*
* COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
*
* Simplify the AST representation.
*)

structure Simplify : sig

val transform : AST.program -> Simple.program

end = struct

structure Ty = Types
structure S = Simple

local
val tempName = Atom.atom "_t"
in
fun newTemp ty = Var.new (tempName, AST.LocalVar, ty)
end

(* make a block out of a list of statements that are in reverse order *)
fun mkBlock stms = S.Block(List.rev stms)

fun simplifyProgram (AST.Program dcls) = let
val globals = ref []
val globalInit = ref []
val initially = ref NONE
val strands = ref []
fun setInitially init = (case !initially
of NONE => initially := SOME init
| SOME _ => raise Fail "multiple initially declarations"
(* end case *))
fun simplifyDecl dcl = (case dcl
of AST.D_Input(x, NONE) => let
val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, NONE)
in
globals := x :: !globals;
globalInit := S.S_Assign(x, e') :: !globalInit
end
| AST.D_Input(x, SOME e) => let
val (stms, x') = simplifyExpToVar (e, [])
val e' = S.E_Input(Var.monoTypeOf x, Var.nameOf x, SOME x')
in
globals := x :: !globals;
globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
end
| AST.D_Var(AST.VD_Decl(x, e)) => let
val (stms, e') = simplifyExp (e, [])
in
globals := x :: !globals;
globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
end
| AST.D_Strand info => strands := simplifyStrand info :: !strands
| AST.D_InitialArray(creat, iters) =>
setInitially (simplifyInit(true, creat, iters))
| AST.D_InitialCollection(creat, iters) =>
setInitially (simplifyInit(false, creat, iters))
(* end case *))
in
List.app simplifyDecl dcls;
S.Program{
globals = List.rev(!globals),
globalInit = mkBlock (!globalInit),
init = valOf(!initially),
strands = List.rev(!strands)
}
end

and simplifyInit (isArray, AST.C_Create(strand, exps), iters) = let
val (stms, xs) = simplifyExpsToVars (exps, [])
val creat = S.C_Create{
argInit = mkBlock stms,
name = strand,
args = xs
}
fun simplifyIter (AST.I_Range(x, e1, e2), (iters, stms)) = let
val (stms, lo) = simplifyExpToVar (e1, stms)
val (stms, hi) = simplifyExpToVar (e2, stms)
in
({param=x, lo=lo, hi=hi}::iters, stms)
end
val (iters, stms) = List.foldl simplifyIter ([], []) iters
in
S.Initially{
isArray = isArray,
rangeInit = mkBlock stms,
iters = List.rev iters,
create = creat
}
end

and simplifyStrand {name, params, state, methods} = let
fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
| simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let
val (stms, e') = simplifyExp (e, stms)
in
simplifyState (r, x::xs, S.S_Assign(x, e') :: stms)
end
val (xs, stm) = simplifyState (state, [], [])
in
S.Strand{
name = name,
params = params,
state = xs, stateInit = stm,
methods = List.map simplifyMethod methods
}
end

and simplifyMethod (AST.M_Method(name, body)) =
S.Method(name, simplifyBlock body)

(* simplify a statement into a single statement (i.e., a block if it expands
* into more than one new statement).
*)
and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))

and simplifyStmt (stm, stms) = (case stm
of AST.S_Block body => let
fun simplify ([], stms) = stms
| simplify (stm::r, stms) = simplify (r, simplifyStmt (stm, stms))
in
simplify (body, stms)
end
| AST.S_Decl(AST.VD_Decl(x, e)) => let
val (stms, e') = simplifyExp (e, stms)
in
S.S_Assign(x, e') :: stms
end
| AST.S_IfThenElse(e, s1, s2) => let
val (stms, x) = simplifyExpToVar (e, stms)
val s1 = simplifyBlock s1
val s2 = simplifyBlock s2
in
S.S_IfThenElse(x, s1, s2) :: stms
end
| AST.S_Assign(x, e) => let
val (stms, e') = simplifyExp (e, stms)
in
S.S_Assign(x, e') :: stms
end
| AST.S_New(name, args) => let
val (stms, xs) = simplifyExpsToVars (args, stms)
in
S.S_New(name, xs) :: stms
end
| AST.S_Die => S.S_Die :: stms
| AST.S_Stabilize => S.S_Stabilize :: stms
(* end case *))

and simplifyExp (exp, stms) = (
case exp
of AST.E_Var x => (case Var.kindOf x
of Var.BasisVar => let
val ty = Var.monoTypeOf x
val x' = newTemp ty
val stm = S.S_Assign(x', S.E_Apply(x, [], [], ty))
in
(stm::stms, S.E_Var x')
end
| _ => (stms, S.E_Var x)
(* end case *))
| AST.E_Lit lit => (stms, S.E_Lit lit)
| AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"
| AST.E_Apply(f, tyArgs, args, ty) => let
val (stms, xs) = simplifyExpsToVars (args, stms)
in
(stms, S.E_Apply(f, tyArgs, xs, ty))
end
| AST.E_Cons es => let
val (stms, xs) = simplifyExpsToVars (es, stms)
in
(stms, S.E_Cons xs)
end
| AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
val (stms, x) = simplifyExpToVar (e, stms)
fun f ([], ys, stms) = (stms, List.rev ys)
| f (NONE::es, ys, stms) = f (es, NONE::ys, stms)
| f (SOME e::es, ys, stms) = let
val (stms, y) = simplifyExpToVar (e, stms)
in
f (es, SOME y::ys, stms)
end
val (stms, indices) = f (indices, [], stms)
in
(stms, S.E_Slice(x, indices, ty))
end
| AST.E_Cond(e1, e2, e3, ty) => let
(* a conditional expression gets turned into an if-then-else statememt *)
val result = newTemp ty
val (stms, x) = simplifyExpToVar (e1, stms)
fun simplifyBranch e = let
val (stms, e) = simplifyExp (e, [])
in
mkBlock (S.S_Assign(result, e)::stms)
end
val s1 = simplifyBranch e2
val s2 = simplifyBranch e3
in
(S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
end
(* end case *))

and simplifyExpToVar (exp, stms) = let
val (stms, e) = simplifyExp (exp, stms)
in
case e
of S.E_Var x => (stms, x)
| _ => let
val x = newTemp (S.typeOf e)
in
(S.S_Assign(x, e)::stms, x)
end
(* end case *)
end

and simplifyExpsToVars (exps, stms) = let
fun f ([], xs, stms) = (stms, List.rev xs)
| f (e::es, xs, stms) = let
val (stms, x) = simplifyExpToVar (e, stms)
in
f (es, x::xs, stms)
end
in
f (exps, [], stms)
end

fun transform ast = let
val simple = simplifyProgram ast
val _ = SimplePP.output (Log.logFile(), simple)	(* DEBUG *)
val simple = Lift.transform simple
in
simple
end

end
```