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

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/high-il/normalize-ein.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/high-il/normalize-ein.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2450 - (view) (download)

1 : cchiw 2397
2 :     structure NormalizeEin = struct
3 :    
4 :     local
5 : cchiw 2445
6 : cchiw 2397 structure E = Ein
7 : cchiw 2450 (* structure P=Printer*)
8 : cchiw 2397
9 :     in
10 :    
11 : cchiw 2449
12 : cchiw 2397 (*Flattens Add constructor: change, expression *)
13 :     fun mkAdd [e]=(1,e)
14 :     | mkAdd(e)=let
15 :     fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')
16 :     |flatten(i,((E.Const c):: l'))=
17 :     if (c>0.0 orelse c<0.0) then let
18 :     val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end
19 :     else flatten(1,l')
20 :     | flatten(i,[])=(i,[])
21 :     | flatten (i,e::l') = let
22 :     val(b,a)=flatten(i,l') in (b,[e]@a) end
23 :    
24 :     val (b,a)=flatten(0,e)
25 :     in case a
26 :     of [] => (1,E.Const(1.0))
27 :     | [e] => (1,e)
28 :     | es => (b,E.Add es)
29 :     (* end case *)
30 :     end
31 : cchiw 2449
32 :     (*
33 : cchiw 2397 fun mkProd [e]=(1,e)
34 :     | mkProd(e)=let
35 :     fun flatten(i,((E.Prod l)::l'))= flatten(1,l@l')
36 :     |flatten(i,((E.Const c):: l'))=
37 :     if(c>0.0 orelse c<0.0) then
38 :     if (c>1.0 orelse c<1.0) then let
39 :     val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end
40 :     else flatten(1,l')
41 :     else (3, [E.Const(0.0)])
42 :     | flatten(i,[])=(i,[])
43 :     | flatten (i,e::l') = let
44 :     val(b,a)=flatten(i,l') in (b,[e]@a) end
45 :     val ( b,a)=flatten(0,e)
46 :     in if(b=3) then (1,E.Const(0.0))
47 :     else case a
48 :     of [] => (1,E.Const(0.0))
49 :     | [e] => (1,e)
50 :     | es => (b, E.Prod es)
51 :     (* end case *)
52 :     end
53 :    
54 :    
55 :     fun mkEps(e)= (case e
56 : cchiw 2437 of E.Apply(E.Partial [E.V a], E.Prod( e2::m ))=> (0,e)
57 :     | E.Apply(E.Partial [E.V a,E.V b], E.Prod( (E.Epsilon(i,j,k))::m ))=>
58 : cchiw 2397 (if(a=i andalso b=j) then (1,E.Const(0.0))
59 :     else if(a=i andalso b=k) then (1,E.Const(0.0))
60 :     else if(a=j andalso b=i) then (1,E.Const(0.0))
61 :     else if(a=j andalso b=k) then (1,E.Const(0.0))
62 :     else if(a=k andalso b=j) then (1,E.Const(0.0))
63 :     else if(a=k andalso b=i) then (1,E.Const(0.0))
64 :     else (0,e))
65 :     |_=> (0,e)
66 :     (*end case*))
67 :    
68 :     fun mkApply(E.Apply(d, e)) = (case e
69 :     of E.Tensor(a,[])=> (0,E.Const(0.0))
70 :     | E.Tensor _=> (0,E.Apply(d,e))
71 :     | E.Const _=> (1,E.Const(0.0))
72 :     | E.Add l => (1,E.Add(List.map (fn e => E.Apply(d, e)) l))
73 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(d, e2), E.Apply(d, e3)))
74 :     | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e))
75 :     | E.Prod[E.Tensor(a,[]), e2]=> (0, E.Prod[ E.Tensor(a,[]), E.Apply(d, e2)] )
76 :     | E.Prod((E.Tensor(a,[]))::e2)=> (0, E.Prod[E.Tensor(a,[]), E.Apply(d, E.Prod e2)] )
77 :     | E.Prod es => (let
78 :     fun prod [e] = (E.Apply(d, e))
79 :     | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]
80 :     val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr
81 :     in ( E.Add[ a, m] )
82 :     end)
83 :     | prod _= (E.Const(1.0))
84 :     in (1,prod es)
85 :     end)
86 :     | _=> (0,E.Apply(d,e))
87 :     (*end case*))
88 :    
89 :     fun mkSumApply(E.Sum(c,E.Apply(d, e))) = (case e
90 :     of E.Tensor(a,[])=> (0,E.Const(0.0))
91 :     | E.Tensor _=> (0,E.Sum(c,E.Apply(d,e)))
92 :     | E.Field _ =>(0, E.Sum(c, E.Apply(d,e)))
93 :     | E.Const _=> (1,E.Const(0.0))
94 :     | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l))
95 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(d, e2)), E.Sum(c,E.Apply(d, e3))))
96 :     | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e))
97 :     | E.Prod[E.Tensor(a,[]), e2]=> (0, E.Prod[ E.Tensor(a,[]), E.Sum(c,E.Apply(d, e2))] )
98 :     | E.Prod((E.Tensor(a,[]))::e2)=> (0, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )
99 :     | E.Prod es => (let
100 :     fun prod [e] = (E.Apply(d, e))
101 :     | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]
102 :     val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr
103 :     in ( E.Add[ a, m] ) end)
104 :     | prod _= (E.Const(1.0))
105 :     in (1, E.Sum(c,prod es)) end)
106 :     | _=> (0,E.Sum(c,E.Apply(d,e)))
107 :     (*end case*))
108 :    
109 :    
110 :    
111 :     (* Identity: (Epsilon ijk Epsilon ilm) e => (Delta jl Delta km - Delta jm Delta kl) e
112 :     The epsToDels Function searches for Epsilons in the expression, checks for this identity in all adjacent Epsilons and if needed, does the transformation.
113 :     The Function returns two separate list, 1 is the remaining list of Epsilons that have not be changed to deltas, and the second is the Product of the remaining expression.
114 :     Ex:(Epsilon_ijk Epsilon_ilm) Epsilon_stu e =>([Epsilon_stu], [Delta_jl,Delta_km,e -Delta_jm Delta_kl, e] )
115 : cchiw 2449 This is useful since we can normalize the second list without having to normalize the epsilons again.
116 :     4(Eps Eps)
117 :     3( Delta_liDelta mj- Delta_mi Delta_lj)
118 :     Ai-
119 :     *)
120 : cchiw 2397
121 : cchiw 2449
122 :     *)
123 :    
124 :    
125 : cchiw 2397 fun epsToDels(E.Sum(count,E.Prod e))= let
126 : cchiw 2449 fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,eps,e3)=
127 : cchiw 2397 let
128 : cchiw 2449
129 :     (*Function is called when eps are being changed to deltas*)
130 :     fun createDeltas(i,s,t,u,v, e3)= let
131 :    
132 :     (*remove index from original index list*)
133 :     (*currrent, left, sumIndex*)
134 :    
135 :     fun rmIndex(_,_,[])=[]
136 :     | rmIndex([],[],cs)=cs
137 :     | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
138 :     | rmIndex(i::ix,rest ,(E.V c)::cs)=
139 :     if(i=c) then rmIndex(rest@ix,[],cs)
140 :     else rmIndex(ix,rest@[i],(E.V c)::cs)
141 :    
142 :     val s'= rmIndex([i,s,t,u,v],[],count)
143 :     val s''=[E.V s, E.V t ,E.V u, E.V v]
144 :     val deltas= E.Sub(
145 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)),
146 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3)))
147 :    
148 :     in (case (eps,s')
149 :     of ([],[]) =>(1,deltas)
150 :     |([],_)=>(1,E.Sum(s',deltas))
151 :     |(_,[])=>(1,E.Prod(eps@[deltas]))
152 :     |(_,_) =>(1, E.Sum(s', E.Prod(eps@[deltas])))
153 :     )
154 :     end
155 :    
156 :     in if(a=d) then createDeltas(a,b,c,e,f, e3)
157 :     else if(a=e) then createDeltas(a,b,c,f,d, e3)
158 :     else if(a=f) then createDeltas(a,b,c,d,e, e3)
159 :     else if(b=d) then createDeltas(b,c,a,e,f, e3)
160 :     else if(b=e) then createDeltas(b,c,a,f,d,e3)
161 :     else if(b=f) then createDeltas(b,c,a,d,e,e3)
162 :     else if(c=d) then createDeltas(c,a,b,e,f,e3)
163 :     else if(c=e) then createDeltas(c,a,b,f,d,e3)
164 :     else if(c=f) then createDeltas(c,a,b,d,e,e3)
165 :     else (0,E.Const 0.0)
166 : cchiw 2397 end
167 :     fun findeps(e,[])= (e,[])
168 :     | findeps(e,(E.Epsilon eps)::es)= findeps(e@[E.Epsilon eps],es)
169 :     | findeps(e,es)= (e, es)
170 : cchiw 2449
171 :    
172 :     fun dist([],eps,rest)=(0,eps,rest)
173 :     | dist([e],eps,rest)=(0,eps@[e],rest)
174 :     | dist(c1::current,eps,rest)=let
175 :     val(i, exp)= doubleEps(c1::current,eps,rest)
176 :     in (case i of 1=>(i,[exp],[E.Const 2.0])
177 :     |_=> dist(current, eps@[c1],rest))
178 :     end
179 : cchiw 2397
180 : cchiw 2449
181 :    
182 :     val (es,rest)=findeps([],e)
183 :    
184 :     in
185 :     dist(es,[],rest)
186 :     end
187 : cchiw 2397
188 : cchiw 2449 (*
189 : cchiw 2397
190 :    
191 :    
192 :    
193 :     (*The Deltas then need to be distributed over to the tensors in the expression e.
194 :     Ex.:Delta ij ,Tensor_j, e=> Tensor_i,e. The mkDelts function compares every Delta in the expression to the tensors in the expressions while keeping the results in the correct order.
195 :     This also returns a list of deltas and a list of the remaining expression.
196 :     *)
197 :    
198 :     fun mkDel(e) = let
199 :     fun Del(i, [],x)= (i,[],x)
200 :     | Del(i, d,[])=(i, d,[])
201 :     | Del(i, (E.Delta(d1,d2))::d, (E.Tensor(id,[x]))::xs)=
202 :     if(x=d2) then (let
203 :     val(i',s,t)= Del(i+1,d, xs)
204 :     in Del(i',s, [E.Tensor(id, [d1])] @t) end)
205 :     else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)
206 :     val(i2,s2,t2)= Del(i',d,[E.Tensor(id,[x])]@t)
207 :     in (i2,s@s2, t2) end )
208 :     | Del(i, (E.Delta(d1,d2))::d, (E.Field(id,[x]))::xs)=
209 :     if(x=d2) then (let
210 :     val(i',s,t)= Del(i+1,d, xs)
211 :     in Del(i',s, [E.Field(id, [d1])] @t) end)
212 :     else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)
213 :     val(i2,s2,t2)= Del(i',d,[E.Field(id,[x])]@t)
214 :     in (i2,s@s2, t2) end )
215 :    
216 :     | Del(i, d, t)= (i,d,t)
217 :     fun findels(e,[])= (e,[])
218 :     | findels(e,es)= let val del1= hd(es)
219 :     in (case del1
220 :     of E.Delta _=> findels(e@[del1],tl(es))
221 :     |_=> (e, es))
222 :     end
223 :     val(a,b)= findels([], e)
224 :     in
225 :     Del(0, a, b)
226 :     end
227 :    
228 :    
229 :     (*The Deltas are distributed over to the tensors in the expression e.
230 :     This function checks for instances of the dotProduct.
231 :     Sum_2 (Delta_ij (A_i B_j D_k))=>Sum_1(A_i B_i) D_k
232 :     *)
233 :     fun checkDot(E.Sum(s,E.Prod e))= let
234 :     fun dot(i,d,r, (E.Tensor(ida,[a]))::(E.Tensor(idb,[b]))::ts)=
235 :     if (a=b) then
236 :     dot(i-1,d@[E.Sum(1,E.Prod[(E.Tensor(ida,[a])), (E.Tensor(idb,[b]))])], [],r@ts)
237 :     else dot(i,d, r@[E.Tensor(idb,[b])],(E.Tensor(ida,[a]))::ts)
238 :     |dot(i, d,r, [t])=dot(i,d@[t], [], r)
239 :     |dot(i,d, [],[])= (i,d, [],[])
240 :     |dot(i,d, r, [])= dot(i,d, [], r)
241 :     |dot(i, d, r, (E.Prod p)::t)= dot (i, d, r, p@t)
242 :     |dot(i,d, r, e)= (i,d@r@e, [], [])
243 :    
244 :     val(i,d,r,c)= dot(s,[],[], e)
245 :     val soln= (case d of [d1]=>d1
246 :     |_=> E.Prod d)
247 :     in E.Sum(i,soln) end
248 :     |checkDot(e)= (e)
249 :    
250 :    
251 :    
252 :    
253 :    
254 :    
255 : cchiw 2449 *)
256 : cchiw 2397
257 : cchiw 2449 fun reduceDelta(E.Sum(c,E.Prod p))=let
258 :    
259 :     fun findDeltas(dels,rest,E.Delta d::es)= findDeltas(dels@[E.Delta d], rest, es)
260 :     | findDeltas(dels,rest,E.Epsilon eps::es)=findDeltas(dels,rest@[E.Epsilon eps],es)
261 :     | findDeltas(dels,rest,es)= (dels,rest,es)
262 :    
263 :     fun rmIndex(_,_,[])=[]
264 :     | rmIndex([],[],cs)=cs
265 :     | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
266 :     | rmIndex(i::ix,rest ,c::cs)=
267 :     if(i=c) then rmIndex(rest@ix,[],cs)
268 :     else rmIndex(ix,rest@[i],c::cs)
269 :    
270 :     fun distribute(change,d,dels,[],done)=(change,dels@d,done)
271 :     | distribute(change,[],[],e,done)=(change,[],done@e)
272 :     | distribute(change,E.Delta(i,j)::ds,dels,E.Tensor(id,[tx])::es,done)=
273 :     if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Tensor(id,[i])])
274 :     else distribute(change,ds,dels@[E.Delta(i,j)],E.Tensor(id,[tx])::es,done)
275 :     | distribute(change,d,dels,e::es,done)=distribute(change,dels@d,[],es,done@[e])
276 :    
277 :     val (dels,eps,es)=findDeltas([],[],p)
278 :     val (change,dels',done)=distribute([],dels,[],es,[])
279 :     val index=rmIndex(change,[],c)
280 :    
281 :     in
282 :     (change, E.Sum(index,E.Prod (eps@dels'@done)))
283 :     end
284 :    
285 :    
286 :    
287 : cchiw 2397 (*Apply normalize to each term in product list
288 :     or Apply normalize to tail of each list*)
289 :     fun normalize (Ein.EIN{params, index, body}) = let
290 :     val changed = ref false
291 :     fun rewriteBody body = (case body
292 :     of E.Const _=> body
293 :     | E.Tensor _ =>body
294 :     | E.Field _=> body
295 : cchiw 2437 | E.Kernel _ =>body
296 : cchiw 2397 | E.Delta _ => body
297 : cchiw 2437 | E.Value _ =>body
298 : cchiw 2397 | E.Epsilon _=>body
299 : cchiw 2449
300 : cchiw 2437 | E.Neg e => E.Neg(rewriteBody e)
301 :     | E.Add es => let val (b,a)= mkAdd(List.map rewriteBody es)
302 :     in if (b=1) then ( changed:=true;a) else a end
303 :     | E.Sub (a,b)=> E.Sub(rewriteBody a, rewriteBody b)
304 :     | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b)
305 : cchiw 2397 | E.Partial _=>body
306 : cchiw 2437 | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha)
307 :     | E.Probe(u,v)=> E.Probe(rewriteBody u, rewriteBody v)
308 :     | E.Image es => E.Image(List.map rewriteBody es)
309 :    
310 : cchiw 2449 (*Product*)
311 :     | E.Prod [e1] => rewriteBody e1
312 : cchiw 2397 | E.Prod(e1::(E.Add(e2))::e3)=>
313 : cchiw 2449 (changed := true; E.Add(List.map (fn e=> E.Prod([e1, e]@e3)) e2))
314 : cchiw 2397 | E.Prod(e1::(E.Sub(e2,e3))::e4)=>
315 : cchiw 2449 (changed :=true; E.Sub(E.Prod([e1, e2]@e4), E.Prod([e1,e3]@e4 )))
316 :     | E.Prod [E.Partial r1,E.Conv(f,deltas)]=>
317 :     (changed :=true;E.Conv(f,deltas@r1))
318 :     | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=>
319 :     (changed:=true; E.Prod([E.Conv(f,deltas@r1)]@ps))
320 :    
321 : cchiw 2437
322 : cchiw 2449 | E.Prod(e::es)=>let
323 :     val e'=rewriteBody e
324 :     val e2=rewriteBody(E.Prod es)
325 :     in(case e2 of E.Prod p'=> E.Prod([e']@p')
326 :     |_=>E.Prod [e',e2])
327 :     end
328 : cchiw 2437
329 : cchiw 2449 (*Apply*)
330 :     | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2)
331 : cchiw 2437
332 :    
333 :    
334 : cchiw 2449 (* Sum *)
335 :     | E.Sum([],e)=> rewriteBody e
336 :     | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
337 :     | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
338 :     | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
339 :     let val (i,e,rest)=epsToDels(body)
340 :     in (case (i, e,rest)
341 :     of (1,[e1],_) =>(changed:=true;e1)
342 :     |(0,eps,[])=>body
343 :     |(0,eps,rest)=>(let
344 :     val p'=rewriteBody(E.Prod rest)
345 :     val p''= (case p' of E.Prod p=>p |e=>[e])
346 :     in E.Sum(c, E.Prod (eps@p'')) end
347 :     )
348 :     |_=>body
349 :     ) end
350 :     | E.Sum(c, E.Prod(E.Delta d::es))=>let
351 :     val (change,body')=reduceDelta(body)
352 :     in (case change of []=>body'|_=>(changed:=true;body')) end
353 :     | E.Sum(c,e)=>E.Sum(c,rewriteBody e)
354 : cchiw 2437
355 : cchiw 2397 (*end case*))
356 :    
357 :     fun loop body = let
358 :     val body' = rewriteBody body
359 :     in
360 :     if !changed
361 : cchiw 2450 then (changed := false; (*print " \n \t => \n \t ";print( P.printbody body');print "\n";*)loop body')
362 : cchiw 2397 else body'
363 :     end
364 :     val b = loop body
365 :     in
366 :     ((Ein.EIN{params=params, index=index, body=b}))
367 :     end
368 : cchiw 2448 end
369 : cchiw 2397
370 :    
371 :     end (* local *)

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