Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/simplify/simplify.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/simplify/simplify.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3504 - (view) (download)

1 : jhr 3437 (* simplify.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 : jhr 3468 * Simplify the AST representation. This phase involves the following transformations:
9 :     *
10 :     * - types are simplified by removing meta variables (which will have been resolved)
11 :     *
12 :     * - expressions are simplified to involve a single operation on variables
13 :     *
14 :     * - global reductions are converted to MapReduce statements
15 :     *
16 :     * - other comprehensions and reductions are converted to foreach loops
17 :     *
18 :     * - unreachable code is pruned
19 :     *
20 :     * - negation of literal integers and reals are constant folded
21 : jhr 3437 *)
22 :    
23 :     structure Simplify : sig
24 :    
25 :     val transform : Error.err_stream * AST.program -> Simple.program
26 :    
27 :     end = struct
28 :    
29 :     structure TU = TypeUtil
30 :     structure S = Simple
31 : jhr 3445 structure STy = SimpleTypes
32 :     structure Ty = Types
33 : jhr 3437 structure VMap = Var.Map
34 :    
35 : jhr 3445 (* convert a Types.ty to a SimpleTypes.ty *)
36 :     fun cvtTy ty = (case ty
37 :     of Ty.T_Var(Ty.TV{bind, ...}) => (case !bind
38 :     of NONE => raise Fail "unresolved type variable"
39 :     | SOME ty => cvtTy ty
40 :     (* end case *))
41 :     | Ty.T_Bool => STy.T_Bool
42 :     | Ty.T_Int => STy.T_Int
43 :     | Ty.T_String => STy.T_String
44 :     | Ty.T_Sequence(ty, NONE) => STy.T_Sequence(cvtTy ty, NONE)
45 : jhr 3452 | Ty.T_Sequence(ty, SOME dim) => STy.T_Sequence(cvtTy ty, SOME(TU.monoDim dim))
46 : jhr 3445 | Ty.T_Named id => STy.T_Named id
47 :     | Ty.T_Kernel n => STy.T_Kernel(TU.monoDiff n)
48 :     | Ty.T_Tensor shape => STy.T_Tensor(TU.monoShape shape)
49 :     | Ty.T_Image{dim, shape} => STy.T_Image{
50 :     dim = TU.monoDim dim,
51 :     shape = TU.monoShape shape
52 :     }
53 :     | Ty.T_Field{diff, dim, shape} => STy.T_Field{
54 :     diff = TU.monoDiff diff,
55 :     dim = TU.monoDim dim,
56 :     shape = TU.monoShape shape
57 :     }
58 : jhr 3452 | Ty.T_Fun(tys1, ty2) => STy.T_Fun(List.map cvtTy tys1, cvtTy ty2)
59 : jhr 3456 | Ty.T_Error => raise Fail "unexpected T_Error in Simplify"
60 : jhr 3445 (* end case *))
61 : jhr 3437
62 :     fun newTemp ty = SimpleVar.new ("_t", SimpleVar.LocalVar, ty)
63 :    
64 : jhr 3456 (* a property to map AST variables to SimpleAST variables *)
65 :     local
66 :     fun cvt x = SimpleVar.new (Var.nameOf x, Var.kindOf x, cvtTy(Var.monoTypeOf x))
67 :     in
68 :     val {getFn = cvtVar, ...} = Var.newProp cvt
69 :     end
70 : jhr 3452
71 : jhr 3456 fun cvtVars xs = List.map cvtVar xs
72 : jhr 3452
73 : jhr 3437 (* make a block out of a list of statements that are in reverse order *)
74 : jhr 3501 fun mkBlock stms = S.Block{props = PropList.newHolder(), code = List.rev stms}
75 : jhr 3437
76 : jhr 3456 fun inputImage (errStrm, nrrd, dim, shape) = (
77 :     case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
78 : jhr 3437 of NONE => raise Fail(concat["nrrd file \"", nrrd, "\" does not have expected type"])
79 : jhr 3452 | SOME info => S.Proxy(nrrd, info)
80 : jhr 3437 (* end case *))
81 :    
82 :     datatype 'a ctl_flow_info
83 :     = EXIT (* stm sequence always exits; no pruning so far *)
84 :     | PRUNE of 'a (* stm sequence always exits at last stm in argument, which
85 : jhr 3445 * is either a block or stm list *)
86 : jhr 3437 | CONT (* stm sequence falls through *)
87 :     | EDIT of 'a (* pruned code that has non-exiting paths *)
88 :    
89 : jhr 3501 fun pruneUnreachableCode blk = let
90 : jhr 3437 fun isExit S.S_Die = true
91 :     | isExit S.S_Stabilize = true
92 :     | isExit (S.S_Return _) = true
93 :     | isExit _ = false
94 :     fun pruneStms [] = CONT
95 :     | pruneStms [S.S_IfThenElse(x, blk1, blk2)] = (
96 :     case pruneIf(x, blk1, blk2)
97 :     of EXIT => EXIT
98 :     | PRUNE stm => PRUNE[stm]
99 :     | CONT => CONT
100 :     | EDIT stm => EDIT[stm]
101 :     (* end case *))
102 :     | pruneStms [stm] = if isExit stm then EXIT else CONT
103 :     | pruneStms ((stm as S.S_IfThenElse(x, blk1, blk2))::stms) = (
104 :     case pruneIf(x, blk1, blk2)
105 :     of EXIT => PRUNE[stm]
106 :     | PRUNE stm => PRUNE[stm]
107 :     | CONT => (case pruneStms stms
108 :     of PRUNE stms => PRUNE(stm::stms)
109 :     | EDIT stms => EDIT(stm::stms)
110 :     | EXIT => EXIT (* different instances of ctl_flow_info *)
111 :     | CONT => CONT
112 :     (* end case *))
113 :     | EDIT stm => (case pruneStms stms
114 :     of PRUNE stms => PRUNE(stm::stms)
115 :     | EDIT stms => EDIT(stm::stms)
116 :     | _ => EDIT(stm::stms)
117 :     (* end case *))
118 :     (* end case *))
119 :     | pruneStms (stm::stms) = if isExit stm
120 :     then PRUNE[stm]
121 :     else (case pruneStms stms
122 :     of PRUNE stms => PRUNE(stm::stms)
123 :     | EDIT stms => EDIT(stm::stms)
124 :     | info => info
125 :     (* end case *))
126 :     and pruneIf (x, blk1, blk2) = (case (pruneBlk blk1, pruneBlk blk2)
127 :     of (EXIT, EXIT ) => EXIT
128 :     | (CONT, CONT ) => CONT
129 :     | (CONT, EXIT ) => CONT
130 :     | (EXIT, CONT ) => CONT
131 :     | (CONT, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
132 :     | (EDIT blk1, CONT ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
133 :     | (CONT, PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))
134 :     | (PRUNE blk1, CONT ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
135 :     | (EXIT, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
136 :     | (EDIT blk1, EXIT ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
137 :     | (EDIT blk1, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
138 :     | (EDIT blk1, PRUNE blk2) => EDIT(S.S_IfThenElse(x, blk1, blk2))
139 :     | (PRUNE blk1, EDIT blk2 ) => EDIT(S.S_IfThenElse(x, blk1, blk2))
140 :     | (EXIT, PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
141 :     | (PRUNE blk1, EXIT ) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
142 :     | (PRUNE blk1, PRUNE blk2) => PRUNE(S.S_IfThenElse(x, blk1, blk2))
143 :     (* end case *))
144 : jhr 3501 and pruneBlk (S.Block{props, code}) = (case pruneStms code
145 :     of PRUNE stms => PRUNE(S.Block{props=props, code=stms})
146 :     | EDIT stms => EDIT(S.Block{props=props, code=stms})
147 : jhr 3437 | EXIT => EXIT (* different instances of ctl_flow_info *)
148 :     | CONT => CONT
149 :     (* end case *))
150 :     in
151 :     case pruneBlk blk
152 :     of PRUNE blk => blk
153 :     | EDIT blk => blk
154 :     | _=> blk
155 :     (* end case *)
156 :     end
157 :    
158 :     (* simplify a statement into a single statement (i.e., a block if it expands
159 :     * into more than one new statement).
160 :     *)
161 : jhr 3456 fun simplifyBlock errStrm stm = mkBlock (simplifyStmt (errStrm, stm, []))
162 : jhr 3437
163 :     (* simplify the statement stm where stms is a reverse-order list of preceeding simplified
164 :     * statements. This function returns a reverse-order list of simplified statements.
165 :     * Note that error reporting is done in the typechecker, but it does not prune unreachable
166 :     * code.
167 :     *)
168 : jhr 3456 and simplifyStmt (errStrm, stm, stms) : S.stmt list = (case stm
169 : jhr 3437 of AST.S_Block body => let
170 : jhr 3456 fun simplify ([], stms) = stms
171 :     | simplify (stm::r, stms) = simplify (r, simplifyStmt (errStrm, stm, stms))
172 : jhr 3437 in
173 : jhr 3456 simplify (body, stms)
174 : jhr 3437 end
175 : jhr 3452 | AST.S_Decl(x, NONE) => let
176 : jhr 3456 val x' = cvtVar x
177 : jhr 3452 in
178 : jhr 3465 S.S_Var(x', NONE) :: stms
179 : jhr 3452 end
180 :     | AST.S_Decl(x, SOME e) => let
181 : jhr 3456 val (stms, e') = simplifyExp (errStrm, e, stms)
182 :     val x' = cvtVar x
183 : jhr 3437 in
184 : jhr 3465 S.S_Var(x', SOME e') :: stms
185 : jhr 3437 end
186 :     | AST.S_IfThenElse(e, s1, s2) => let
187 : jhr 3456 val (stms, x) = simplifyExpToVar (errStrm, e, stms)
188 :     val s1 = simplifyBlock errStrm s1
189 :     val s2 = simplifyBlock errStrm s2
190 : jhr 3437 in
191 : jhr 3456 S.S_IfThenElse(x, s1, s2) :: stms
192 : jhr 3437 end
193 : jhr 3456 | AST.S_Foreach((x, e), body) => let
194 :     val (stms, xs') = simplifyExpToVar (errStrm, e, stms)
195 :     val body' = simplifyBlock errStrm body
196 :     in
197 :     S.S_Foreach(cvtVar x, xs', body') :: stms
198 :     end
199 : jhr 3452 | AST.S_Assign((x, _), e) => let
200 : jhr 3456 val (stms, e') = simplifyExp (errStrm, e, stms)
201 : jhr 3437 in
202 : jhr 3456 S.S_Assign(cvtVar x, e') :: stms
203 : jhr 3437 end
204 :     | AST.S_New(name, args) => let
205 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
206 : jhr 3437 in
207 : jhr 3456 S.S_New(name, xs) :: stms
208 : jhr 3437 end
209 : jhr 3456 | AST.S_Continue => S.S_Continue :: stms
210 :     | AST.S_Die => S.S_Die :: stms
211 :     | AST.S_Stabilize => S.S_Stabilize :: stms
212 : jhr 3437 | AST.S_Return e => let
213 : jhr 3456 val (stms, x) = simplifyExpToVar (errStrm, e, stms)
214 : jhr 3437 in
215 : jhr 3456 S.S_Return x :: stms
216 : jhr 3437 end
217 :     | AST.S_Print args => let
218 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
219 : jhr 3437 in
220 : jhr 3456 S.S_Print xs :: stms
221 : jhr 3437 end
222 :     (* end case *))
223 :    
224 : jhr 3456 and simplifyExp (errStrm, exp, stms) = let
225 : jhr 3452 fun doPrimApply (f, tyArgs, args, ty) = let
226 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
227 : jhr 3437 in
228 :     case Var.kindOf f
229 : jhr 3452 of Var.BasisVar => let
230 : jhr 3437 fun cvtTyArg (Types.TYPE tv) = S.TY(cvtTy(TU.resolve tv))
231 :     | cvtTyArg (Types.DIFF dv) = S.DIFF(TU.monoDiff(TU.resolveDiff dv))
232 :     | cvtTyArg (Types.SHAPE sv) = S.SHAPE(TU.monoShape(TU.resolveShape sv))
233 :     | cvtTyArg (Types.DIM dv) = S.DIM(TU.monoDim(TU.resolveDim dv))
234 :     val tyArgs = List.map cvtTyArg tyArgs
235 :     in
236 :     (stms, S.E_Prim(f, tyArgs, xs, cvtTy ty))
237 :     end
238 : jhr 3452 | _ => raise Fail "bogus prim application"
239 : jhr 3437 (* end case *)
240 :     end
241 :     in
242 :     case exp
243 : jhr 3452 of AST.E_Var(x, _) => (case Var.kindOf x
244 : jhr 3437 of Var.BasisVar => let
245 :     val ty = cvtTy(Var.monoTypeOf x)
246 :     val x' = newTemp ty
247 : jhr 3465 val stm = S.S_Var(x', SOME(S.E_Prim(x, [], [], ty)))
248 : jhr 3437 in
249 :     (stm::stms, S.E_Var x')
250 :     end
251 : jhr 3456 | _ => (stms, S.E_Var(cvtVar x))
252 : jhr 3437 (* end case *))
253 :     | AST.E_Lit lit => (stms, S.E_Lit lit)
254 : jhr 3456 | AST.E_Select(e, (fld, _)) => let
255 :     val (stms, x) = simplifyExpToVar (errStrm, e, stms)
256 :     in
257 :     (stms, S.E_Select(x, cvtVar fld))
258 :     end
259 : jhr 3464 | AST.E_Prim(rator, tyArgs, args as [e], ty) => (case e
260 :     of AST.E_Lit(Literal.Int n) => if Var.same(BasisVars.neg_i, rator)
261 :     then (stms, S.E_Lit(Literal.Int(~n))) (* constant-fold negation of integer literals *)
262 :     else doPrimApply (rator, tyArgs, args, ty)
263 :     | AST.E_Lit(Literal.Real f) =>
264 :     if Var.same(BasisVars.neg_t, rator)
265 :     then (stms, S.E_Lit(Literal.Real(RealLit.negate f))) (* constant-fold negation of real literals *)
266 :     else doPrimApply (rator, tyArgs, args, ty)
267 :     | AST.E_Comprehension(e', (x, e''), seqTy) => if Basis.isReductionOp rator
268 :     then let
269 :     val {rator, init, mvs} = Util.reductionInfo rator
270 :     val (stms, xs) = simplifyExpToVar (errStrm, e'', stms)
271 :     val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e, [])
272 :     val acc = SimpleVar.new ("accum", Var.LocalVar, cvtTy ty)
273 :     val seqTy' as STy.T_Sequence(elemTy, NONE) = cvtTy seqTy
274 : jhr 3465 val initStm = S.S_Var(acc, SOME(S.E_Lit init))
275 : jhr 3464 val updateStm = S.S_Assign(acc,
276 :     S.E_Prim(rator, mvs, [acc, bodyResult], seqTy'))
277 :     val foreachStm = S.S_Foreach(cvtVar x, xs, mkBlock(updateStm :: bodyStms))
278 :     in
279 :     (foreachStm :: initStm :: stms, S.E_Var acc)
280 :     end
281 :     else doPrimApply (rator, tyArgs, args, ty)
282 :     | AST.E_ParallelMap(e', x, xs, _) =>
283 :     if Basis.isReductionOp rator
284 : jhr 3465 then let
285 :     (* parallel map-reduce *)
286 :     val result = SimpleVar.new ("res", Var.LocalVar, cvtTy ty)
287 :     val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e', [])
288 :     val (func, args) = Util.makeFunction(
289 :     Var.nameOf rator, mkBlock(S.S_Return bodyResult :: bodyStms),
290 :     SimpleVar.typeOf bodyResult)
291 :     val mapReduceStm = S.S_MapReduce{
292 :     results = [result],
293 :     reductions = [rator],
294 :     body = func,
295 :     args = args,
296 :     source = xs
297 :     }
298 :     in
299 :     (mapReduceStm :: stms, S.E_Var result)
300 :     end
301 : jhr 3464 else raise Fail "unsupported operation on parallel map"
302 :     | _ => doPrimApply (rator, tyArgs, args, ty)
303 :     (* end case *))
304 : jhr 3452 | AST.E_Prim(f, tyArgs, args, ty) => doPrimApply (f, tyArgs, args, ty)
305 :     | AST.E_Apply((f, _), args, ty) => let
306 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, args, stms)
307 : jhr 3452 in
308 :     case Var.kindOf f
309 : jhr 3456 of Var.FunVar => (stms, S.E_Apply(cvtVar f, xs, cvtTy ty))
310 : jhr 3452 | _ => raise Fail "bogus application"
311 :     (* end case *)
312 :     end
313 : jhr 3464 | AST.E_Comprehension(e, (x, e'), seqTy) => let
314 :     (* convert a comprehension to a foreach loop over the sequence defined by e' *)
315 :     val (stms, xs) = simplifyExpToVar (errStrm, e', stms)
316 :     val (bodyStms, bodyResult) = simplifyExpToVar (errStrm, e, [])
317 :     val seqTy' as STy.T_Sequence(elemTy, NONE) = cvtTy seqTy
318 :     val acc = SimpleVar.new ("accum", Var.LocalVar, seqTy')
319 : jhr 3465 val initStm = S.S_Var(acc, SOME(S.E_Seq([], seqTy')))
320 : jhr 3464 val updateStm = S.S_Assign(acc,
321 :     S.E_Prim(BasisVars.at_dT, [S.TY elemTy], [acc, bodyResult], seqTy'))
322 :     val foreachStm = S.S_Foreach(cvtVar x, xs, mkBlock(updateStm :: bodyStms))
323 :     in
324 :     (foreachStm :: initStm :: stms, S.E_Var acc)
325 :     end
326 : jhr 3467 | AST.E_ParallelMap(e, x, xs, ty) => raise Fail "FIXME: ParallelMap"
327 : jhr 3452 | AST.E_Tensor(es, ty) => let
328 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
329 : jhr 3437 in
330 : jhr 3452 (stms, S.E_Tensor(xs, cvtTy ty))
331 : jhr 3437 end
332 :     | AST.E_Seq(es, ty) => let
333 : jhr 3456 val (stms, xs) = simplifyExpsToVars (errStrm, es, stms)
334 : jhr 3437 in
335 :     (stms, S.E_Seq(xs, cvtTy ty))
336 :     end
337 :     | AST.E_Slice(e, indices, ty) => let (* tensor slicing *)
338 : jhr 3456 val (stms, x) = simplifyExpToVar (errStrm, e, stms)
339 : jhr 3437 fun f ([], ys, stms) = (stms, List.rev ys)
340 :     | f (NONE::es, ys, stms) = f (es, NONE::ys, stms)
341 :     | f (SOME e::es, ys, stms) = let
342 : jhr 3456 val (stms, y) = simplifyExpToVar (errStrm, e, stms)
343 : jhr 3437 in
344 :     f (es, SOME y::ys, stms)
345 :     end
346 :     val (stms, indices) = f (indices, [], stms)
347 :     in
348 :     (stms, S.E_Slice(x, indices, cvtTy ty))
349 :     end
350 :     | AST.E_Cond(e1, e2, e3, ty) => let
351 :     (* a conditional expression gets turned into an if-then-else statememt *)
352 :     val result = newTemp(cvtTy ty)
353 : jhr 3465 val (stms, x) = simplifyExpToVar (errStrm, e1, S.S_Var(result, NONE) :: stms)
354 : jhr 3437 fun simplifyBranch e = let
355 : jhr 3456 val (stms, e) = simplifyExp (errStrm, e, [])
356 : jhr 3437 in
357 :     mkBlock (S.S_Assign(result, e)::stms)
358 :     end
359 :     val s1 = simplifyBranch e2
360 :     val s2 = simplifyBranch e3
361 :     in
362 :     (S.S_IfThenElse(x, s1, s2) :: stms, S.E_Var result)
363 :     end
364 :     | AST.E_LoadNrrd(_, nrrd, ty) => (case cvtTy ty
365 : jhr 3452 of ty as SimpleTypes.T_Sequence(_, NONE) => (stms, S.E_LoadSeq(ty, nrrd))
366 : jhr 3437 | ty as SimpleTypes.T_Image{dim, shape} => (
367 : jhr 3456 case ImageInfo.fromNrrd(NrrdInfo.getInfo(errStrm, nrrd), dim, shape)
368 : jhr 3437 of NONE => raise Fail(concat[
369 :     "nrrd file \"", nrrd, "\" does not have expected type"
370 :     ])
371 :     | SOME info => (stms, S.E_LoadImage(ty, nrrd, info))
372 :     (* end case *))
373 :     | _ => raise Fail "bogus type for E_LoadNrrd"
374 :     (* end case *))
375 :     | AST.E_Coerce{srcTy, dstTy, e} => let
376 : jhr 3456 val (stms, x) = simplifyExpToVar (errStrm, e, stms)
377 : jhr 3437 val dstTy = cvtTy dstTy
378 :     val result = newTemp dstTy
379 :     val rhs = S.E_Coerce{srcTy = cvtTy srcTy, dstTy = dstTy, x = x}
380 :     in
381 : jhr 3465 (S.S_Var(result, SOME rhs)::stms, S.E_Var result)
382 : jhr 3437 end
383 :     (* end case *)
384 :     end
385 :    
386 : jhr 3456 and simplifyExpToVar (errStrm, exp, stms) = let
387 :     val (stms, e) = simplifyExp (errStrm, exp, stms)
388 : jhr 3437 in
389 :     case e
390 :     of S.E_Var x => (stms, x)
391 :     | _ => let
392 :     val x = newTemp (S.typeOf e)
393 :     in
394 : jhr 3465 (S.S_Var(x, SOME e)::stms, x)
395 : jhr 3437 end
396 :     (* end case *)
397 :     end
398 :    
399 : jhr 3456 and simplifyExpsToVars (errStrm, exps, stms) = let
400 : jhr 3437 fun f ([], xs, stms) = (stms, List.rev xs)
401 :     | f (e::es, xs, stms) = let
402 : jhr 3456 val (stms, x) = simplifyExpToVar (errStrm, e, stms)
403 : jhr 3437 in
404 :     f (es, x::xs, stms)
405 :     end
406 :     in
407 :     f (exps, [], stms)
408 :     end
409 :    
410 : jhr 3456 fun simplifyStrand (errStrm, AST.Strand{name, params, state, initM, updateM, stabilizeM}) = let
411 :     val params' = cvtVars params
412 :     fun simplifyState ([], xs, stms) = (List.rev xs, mkBlock stms)
413 :     | simplifyState ((x, optE) :: r, xs, stms) = let
414 :     val x' = cvtVar x
415 : jhr 3452 in
416 :     case optE
417 : jhr 3456 of NONE => simplifyState (r, x'::xs, stms)
418 : jhr 3452 | SOME e => let
419 : jhr 3456 val (stms, e') = simplifyExp (errStrm, e, stms)
420 : jhr 3452 in
421 : jhr 3469 simplifyState (r, x'::xs, S.S_Assign(x', e') :: stms)
422 : jhr 3452 end
423 :     (* end case *)
424 :     end
425 : jhr 3456 val (xs, stm) = simplifyState (state, [], [])
426 : jhr 3437 in
427 : jhr 3452 S.Strand{
428 :     name = name,
429 :     params = params',
430 : jhr 3456 state = xs,
431 :     stateInit = stm,
432 :     initM = Option.map (simplifyBlock errStrm) initM,
433 :     updateM = simplifyBlock errStrm updateM,
434 :     stabilizeM = Option.map (simplifyBlock errStrm) stabilizeM
435 : jhr 3452 }
436 : jhr 3437 end
437 :    
438 : jhr 3485 fun simplifyCreate (errStrm, AST.C_Grid(d, blk)) =
439 :     S.Create{dim = SOME d, code = simplifyBlock errStrm blk}
440 :     | simplifyCreate (errStrm, AST.C_Collection blk) =
441 :     S.Create{dim = NONE, code = simplifyBlock errStrm blk}
442 : jhr 3456
443 : jhr 3452 fun transform (errStrm, prog) = let
444 :     val AST.Program{
445 :     props, const_dcls, input_dcls, globals, init, strand, create, update
446 :     } = prog
447 : jhr 3456 val consts' = ref[]
448 :     val constInit = ref[]
449 : jhr 3452 val inputs' = ref[]
450 :     val globals' = ref[]
451 :     val globalInit = ref[]
452 :     val funcs = ref[]
453 : jhr 3456 fun simplifyConstDcl (x, SOME e) = let
454 :     val (stms, e') = simplifyExp (errStrm, e, [])
455 :     val x' = cvtVar x
456 : jhr 3452 in
457 : jhr 3456 consts' := x' :: !consts';
458 :     constInit := S.S_Assign(x', e') :: (stms @ !constInit)
459 :     end
460 :     fun simplifyInputDcl ((x, NONE), desc) = let
461 :     val x' = cvtVar x
462 :     val init = (case SimpleVar.typeOf x'
463 :     of SimpleTypes.T_Image{dim, shape} => let
464 :     val info = ImageInfo.mkInfo(dim, shape)
465 :     in
466 :     S.Image info
467 :     end
468 :     | _ => S.NoDefault
469 :     (* end case *))
470 :     val inp = S.INP{
471 :     var = x',
472 : jhr 3504 name = Var.nameOf x,
473 : jhr 3456 desc = desc,
474 :     init = init
475 :     }
476 :     in
477 :     inputs' := inp :: !inputs'
478 :     end
479 :     | simplifyInputDcl ((x, SOME(AST.E_LoadNrrd(tvs, nrrd, ty))), desc) = let
480 :     val x' = cvtVar x
481 :     (* load the nrrd proxy here *)
482 :     val info = NrrdInfo.getInfo (errStrm, nrrd)
483 :     val init = (case SimpleVar.typeOf x'
484 :     of SimpleTypes.T_Sequence(_, NONE) => S.LoadSeq nrrd
485 :     | SimpleTypes.T_Image{dim, shape} => inputImage(errStrm, nrrd, dim, shape)
486 :     | _ => raise Fail "impossible"
487 :     (* end case *))
488 :     val inp = S.INP{
489 :     var = x',
490 : jhr 3504 name = Var.nameOf x,
491 : jhr 3456 desc = desc,
492 :     init = init
493 :     }
494 :     in
495 :     inputs' := inp :: !inputs'
496 :     end
497 :     | simplifyInputDcl ((x, SOME e), desc) = let
498 :     val x' = cvtVar x
499 :     val (stms, e') = simplifyExp (errStrm, e, [])
500 :     val inp = S.INP{
501 :     var = x',
502 : jhr 3504 name = Var.nameOf x,
503 : jhr 3456 desc = desc,
504 :     init = S.ConstExpr
505 :     }
506 :     in
507 :     inputs' := inp :: !inputs';
508 :     constInit := S.S_Assign(x', e') :: (stms @ !constInit)
509 :     end
510 :     fun simplifyGlobalDcl (AST.D_Var(x, optE)) = let
511 :     val x' = cvtVar x
512 :     in
513 : jhr 3452 case optE
514 : jhr 3456 of NONE => globals' := x' :: !globals'
515 : jhr 3452 | SOME e => let
516 : jhr 3456 val (stms, e') = simplifyExp (errStrm, e, [])
517 : jhr 3452 in
518 :     globals' := x' :: !globals';
519 : jhr 3456 globalInit := S.S_Assign(x', e') :: (stms @ !globalInit)
520 : jhr 3452 end
521 :     (* end case *)
522 :     end
523 : jhr 3456 | simplifyGlobalDcl (AST.D_Func(f, params, body)) = let
524 :     val f' = cvtVar f
525 :     val params' = cvtVars params
526 :     val body' = pruneUnreachableCode (simplifyBlock errStrm body)
527 : jhr 3452 in
528 : jhr 3456 funcs := S.Func{f=f', params=params', body=body'} :: !funcs
529 : jhr 3452 end
530 :     in
531 : jhr 3456 List.app simplifyConstDcl const_dcls;
532 :     List.app simplifyInputDcl input_dcls;
533 :     List.app simplifyGlobalDcl globals;
534 : jhr 3452 S.Program{
535 :     props = props,
536 : jhr 3456 consts = List.rev(!consts'),
537 : jhr 3452 inputs = List.rev(!inputs'),
538 : jhr 3456 constInit = mkBlock (!constInit),
539 : jhr 3452 globals = List.rev(!globals'),
540 :     init = mkBlock (!globalInit),
541 :     funcs = List.rev(!funcs),
542 : jhr 3456 strand = simplifyStrand (errStrm, strand),
543 :     create = simplifyCreate (errStrm, create),
544 :     update = Option.map (simplifyBlock errStrm) update
545 : jhr 3452 }
546 :     end
547 :    
548 : jhr 3437 end

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