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

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