Annotation of /trunk/src/compiler/simplify/simplify.sml

Parent Directory | Revision Log

---

Revision 221 - (view) (download)

1 :	jhr	171	(* simplify.sml
2 :			*
3 :			* COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*
6 :			* Simplify the AST representation.
7 :			*)
8 :
9 :			structure Simplify : sig
10 :
11 :			val transform : AST.program -> Simple.program
12 :
13 :			end = struct
14 :
15 :			structure Ty = Types
16 :			structure S = Simple
17 :
18 :			local
19 :			val tempName = Atom.atom "_t"
20 :			in
21 :			fun newTemp ty = Var.new (tempName, AST.LocalVar, ty)
22 :			end
23 :
24 :			(* make a block out of a list of statements that are in reverse order *)
25 :	jhr	197	fun mkBlock stms = S.Block(List.rev stms)
26 :	jhr	171
27 :			fun transform (AST.Program dcls) = let
28 :			val globals = ref []
29 :			val globalInit = ref []
30 :			val actors = ref []
31 :			fun simplifyDecl dcl = (case dcl
32 :	jhr	185	of AST.D_Input(x, NONE) => let
33 :	jhr	221	val e' = S.E_Input(Var.nameOf x, NONE)
34 :	jhr	185	in
35 :			globals := x :: !globals;
36 :	jhr	221	globalInit := S.S_Assign(x, e') :: !globalInit
37 :	jhr	185	end
38 :	jhr	171	| AST.D_Input(x, SOME e) => let
39 :	jhr	179	val (stms, x') = simplifyExpToVar (e, [])
40 :	jhr	221	val e' = S.E_Input(Var.nameOf x, SOME x')
41 :	jhr	171	in
42 :			globals := x :: !globals;
43 :	jhr	221	globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
44 :	jhr	171	end
45 :			| AST.D_Var(AST.VD_Decl(x, e)) => let
46 :			val (stms, e') = simplifyExp (e, [])
47 :			in
48 :			globals := x :: !globals;
49 :			globalInit := S.S_Assign(x, e') :: (stms @ !globalInit)
50 :			end
51 :			| AST.D_Actor info => actors := simplifyActor info :: !actors
52 :			| AST.D_InitialArray(e, iters) => () (* FIXME *)
53 :			| AST.D_InitialCollection(e, iters) => () (* FIXME *)
54 :			(* end case *))
55 :			in
56 :			List.app simplifyDecl dcls;
57 :	jhr	175	S.Program{
58 :	jhr	171	globals = List.rev(!globals),
59 :			globalInit = mkBlock (!globalInit),
60 :			actors = List.rev(!actors)
61 :			}
62 :			end
63 :
64 :			and simplifyActor {name, params, state, methods} = let
65 :			fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
66 :			| simplifyState (AST.VD_Decl(x, e) :: r, xs, stms) = let
67 :			val (stms, e') = simplifyExp (e, stms)
68 :			in
69 :			simplifyState (r, x::xs, S.S_Assign(x, e') :: stms)
70 :			end
71 :			val (xs, stm) = simplifyState (state, [], [])
72 :			in
73 :			S.Actor{
74 :	jhr	173	name = name,
75 :	jhr	171	params = params,
76 :			state = xs, stateInit = stm,
77 :			methods = List.map simplifyMethod methods
78 :			}
79 :			end
80 :
81 :			and simplifyMethod (AST.M_Method(name, body)) =
82 :	jhr	197	S.Method(name, simplifyBlock body)
83 :	jhr	171
84 :			(* simplify a statement into a single statement (i.e., a block if it expands into more
85 :			* than one new statement.
86 :			*)
87 :			and simplifyBlock stm = mkBlock (simplifyStmt (stm, []))
88 :
89 :			and simplifyStmt (stm, stms) = (case stm
90 :			of AST.S_Block body => let
91 :			fun simplify ([], stms) = stms
92 :			| simplify (stm::r, stms) = simplify (r, simplifyStmt (stm, stms))
93 :			in
94 :			simplify (body, stms)
95 :			end
96 :			| AST.S_Decl(AST.VD_Decl(x, e)) => let
97 :			val (stms, e') = simplifyExp (e, stms)
98 :			in
99 :			S.S_Assign(x, e') :: stms
100 :			end
101 :			| AST.S_IfThenElse(e, s1, s2) => let
102 :			val (stms, x) = simplifyExpToVar (e, stms)
103 :			val s1 = simplifyBlock s1
104 :			val s2 = simplifyBlock s2
105 :			in
106 :			S.S_IfThenElse(x, s1, s2) :: stms
107 :			end
108 :			| AST.S_Assign(x, e) => let
109 :			val (stms, e') = simplifyExp (e, stms)
110 :			in
111 :			S.S_Assign(x, e') :: stms
112 :			end
113 :			| AST.S_New(name, args) => let
114 :			val (stms, xs) = simplifyExpsToVars (args, stms)
115 :			in
116 :			S.S_New(name, xs) :: stms
117 :			end
118 :			| AST.S_Die => S.S_Die :: stms
119 :			| AST.S_Stabilize => S.S_Stabilize :: stms
120 :			(* end case *))
121 :
122 :			and simplifyExp (exp, stms) = (
123 :			case exp
124 :	jhr	197	of AST.E_Var x => (case Var.kindOf x
125 :			of Var.BasisVar => let
126 :			val ty = Var.monoTypeOf x
127 :			val x' = newTemp ty
128 :			val stm = S.S_Assign(x', S.E_Apply(x, [], [], ty))
129 :			in
130 :			(stm::stms, S.E_Var x')
131 :			end
132 :			| _ => (stms, S.E_Var x)
133 :			(* end case *))
134 :	jhr	171	| AST.E_Lit lit => (stms, S.E_Lit lit)
135 :			| AST.E_Tuple es => raise Fail "E_Tuple not yet implemented"
136 :			| AST.E_Apply(f, tyArgs, args, ty) => let
137 :			val (stms, xs) = simplifyExpsToVars (args, stms)
138 :			in
139 :			(stms, S.E_Apply(f, tyArgs, xs, ty))
140 :			end
141 :			| AST.E_Cons es => let
142 :			val (stms, xs) = simplifyExpsToVars (es, stms)
143 :			in
144 :			(stms, S.E_Cons xs)
145 :			end
146 :			| AST.E_Cond(e1, e2, e3) => let
147 :			(* a conditional expression gets turned into an if-then-else statememt *)
148 :			val result = newTemp Ty.T_Bool
149 :			val (stms, x) = simplifyExpToVar (e1, stms)
150 :			fun simplifyBranch e = let
151 :			val (stms, e) = simplifyExp (e, [])
152 :			in
153 :			mkBlock (S.S_Assign(result, e)::stms)
154 :			end
155 :			val s1 = simplifyBranch e1
156 :			val s2 = simplifyBranch e2
157 :			in
158 :			(S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
159 :			end
160 :			(* end case *))
161 :
162 :			and simplifyExpToVar (exp, stms) = let
163 :			val (stms, e) = simplifyExp (exp, stms)
164 :			in
165 :			case e
166 :			of S.E_Var x => (stms, x)
167 :			| _ => let
168 :			val x = newTemp (S.typeOf e)
169 :			in
170 :			(S.S_Assign(x, e)::stms, x)
171 :			end
172 :			(* end case *)
173 :			end
174 :
175 :			and simplifyExpsToVars (exps, stms) = let
176 :			fun f ([], xs, stms) = (stms, List.rev xs)
177 :			| f (e::es, xs, stms) = let
178 :			val (stms, x) = simplifyExpToVar (e, stms)
179 :			in
180 :			f (es, x::xs, stms)
181 :			end
182 :			in
183 :			f (exps, [], stms)
184 :			end
185 :
186 :			end

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0