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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2452 - (view) (download)
Original Path: branches/charisee/src/compiler/high-il/normalize-ein.sml

1 : cchiw 2397
2 :     structure NormalizeEin = struct
3 :    
4 :     local
5 : cchiw 2445
6 : cchiw 2397 structure E = Ein
7 : cchiw 2452 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 : cchiw 2452
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 : cchiw 2452 |flatten(i,((E.Const c)::l'))=
37 :     if(c>0.0 orelse 0.0>c) then (3,[E.Const 0.0])
38 :     else flatten(i,l')
39 : cchiw 2397 | flatten(i,[])=(i,[])
40 : cchiw 2452 | flatten (i,e::l') = let val(a,b)=flatten(i,l') in (a,[e]@b) end
41 :     val (change,a)=flatten(0,e)
42 :     in if(change=3) then (1,E.Const(0.0))
43 : cchiw 2397 else case a
44 :     of [] => (1,E.Const(0.0))
45 :     | [e] => (1,e)
46 : cchiw 2452 | es => (change, E.Prod es)
47 : cchiw 2397 (* end case *)
48 :     end
49 : cchiw 2452
50 :     (*
51 : cchiw 2397
52 :     fun mkEps(e)= (case e
53 : cchiw 2437 of E.Apply(E.Partial [E.V a], E.Prod( e2::m ))=> (0,e)
54 :     | E.Apply(E.Partial [E.V a,E.V b], E.Prod( (E.Epsilon(i,j,k))::m ))=>
55 : cchiw 2397 (if(a=i andalso b=j) then (1,E.Const(0.0))
56 :     else if(a=i andalso b=k) then (1,E.Const(0.0))
57 :     else if(a=j andalso b=i) then (1,E.Const(0.0))
58 :     else if(a=j andalso b=k) then (1,E.Const(0.0))
59 :     else if(a=k andalso b=j) then (1,E.Const(0.0))
60 :     else if(a=k andalso b=i) then (1,E.Const(0.0))
61 :     else (0,e))
62 :     |_=> (0,e)
63 :     (*end case*))
64 :    
65 : cchiw 2452
66 : cchiw 2397
67 :     fun mkSumApply(E.Sum(c,E.Apply(d, e))) = (case e
68 :     of E.Tensor(a,[])=> (0,E.Const(0.0))
69 :     | E.Tensor _=> (0,E.Sum(c,E.Apply(d,e)))
70 :     | E.Field _ =>(0, E.Sum(c, E.Apply(d,e)))
71 :     | E.Const _=> (1,E.Const(0.0))
72 :     | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l))
73 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(d, e2)), E.Sum(c,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.Sum(c,E.Apply(d, e2))] )
76 :     | E.Prod((E.Tensor(a,[]))::e2)=> (0, E.Prod[E.Tensor(a,[]), E.Sum(c,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] ) end)
82 :     | prod _= (E.Const(1.0))
83 :     in (1, E.Sum(c,prod es)) end)
84 :     | _=> (0,E.Sum(c,E.Apply(d,e)))
85 :     (*end case*))
86 :    
87 : cchiw 2452 *)
88 :    
89 :    
90 :     fun rmEpsIndex(_,_,[])=[]
91 :     | rmEpsIndex([],[],cs)=cs
92 :     | rmEpsIndex([],m ,e1::cs)=[e1]@rmEpsIndex(m,[],cs)
93 :     | rmEpsIndex(i::ix,rest ,(E.V c)::cs)=
94 :     if(i=c) then rmEpsIndex(rest@ix,[],cs)
95 :     else rmEpsIndex(ix,rest@[i],(E.V c)::cs)
96 :    
97 : cchiw 2397
98 : cchiw 2452 (* Transform eps to deltas*)
99 : cchiw 2397 fun epsToDels(E.Sum(count,E.Prod e))= let
100 : cchiw 2449 fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,eps,e3)=
101 : cchiw 2397 let
102 : cchiw 2449
103 :     (*Function is called when eps are being changed to deltas*)
104 :     fun createDeltas(i,s,t,u,v, e3)= let
105 :    
106 :     (*remove index from original index list*)
107 :     (*currrent, left, sumIndex*)
108 :    
109 : cchiw 2452 val s'= rmEpsIndex([i,s,t,u,v],[],count)
110 : cchiw 2449 val s''=[E.V s, E.V t ,E.V u, E.V v]
111 :     val deltas= E.Sub(
112 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)),
113 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3)))
114 :    
115 :     in (case (eps,s')
116 :     of ([],[]) =>(1,deltas)
117 :     |([],_)=>(1,E.Sum(s',deltas))
118 :     |(_,[])=>(1,E.Prod(eps@[deltas]))
119 :     |(_,_) =>(1, E.Sum(s', E.Prod(eps@[deltas])))
120 :     )
121 :     end
122 :    
123 :     in if(a=d) then createDeltas(a,b,c,e,f, e3)
124 :     else if(a=e) then createDeltas(a,b,c,f,d, e3)
125 :     else if(a=f) then createDeltas(a,b,c,d,e, e3)
126 :     else if(b=d) then createDeltas(b,c,a,e,f, e3)
127 :     else if(b=e) then createDeltas(b,c,a,f,d,e3)
128 :     else if(b=f) then createDeltas(b,c,a,d,e,e3)
129 :     else if(c=d) then createDeltas(c,a,b,e,f,e3)
130 :     else if(c=e) then createDeltas(c,a,b,f,d,e3)
131 :     else if(c=f) then createDeltas(c,a,b,d,e,e3)
132 :     else (0,E.Const 0.0)
133 : cchiw 2397 end
134 :     fun findeps(e,[])= (e,[])
135 :     | findeps(e,(E.Epsilon eps)::es)= findeps(e@[E.Epsilon eps],es)
136 :     | findeps(e,es)= (e, es)
137 : cchiw 2449
138 :    
139 :     fun dist([],eps,rest)=(0,eps,rest)
140 :     | dist([e],eps,rest)=(0,eps@[e],rest)
141 :     | dist(c1::current,eps,rest)=let
142 :     val(i, exp)= doubleEps(c1::current,eps,rest)
143 :     in (case i of 1=>(i,[exp],[E.Const 2.0])
144 :     |_=> dist(current, eps@[c1],rest))
145 : cchiw 2452 end
146 : cchiw 2449
147 :     val (es,rest)=findeps([],e)
148 :    
149 :     in
150 :     dist(es,[],rest)
151 :     end
152 : cchiw 2397
153 :    
154 : cchiw 2452 fun rmIndex(_,_,[])=[]
155 :     | rmIndex([],[],cs)=cs
156 :     | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
157 :     | rmIndex(i::ix,rest ,c::cs)=
158 :     if(i=c) then rmIndex(rest@ix,[],cs)
159 :     else rmIndex(ix,rest@[i],c::cs)
160 :    
161 :     (* Apply deltas to tensors/fields*)
162 : cchiw 2449 fun reduceDelta(E.Sum(c,E.Prod p))=let
163 :    
164 :     fun findDeltas(dels,rest,E.Delta d::es)= findDeltas(dels@[E.Delta d], rest, es)
165 :     | findDeltas(dels,rest,E.Epsilon eps::es)=findDeltas(dels,rest@[E.Epsilon eps],es)
166 :     | findDeltas(dels,rest,es)= (dels,rest,es)
167 :    
168 : cchiw 2452
169 : cchiw 2449 fun distribute(change,d,dels,[],done)=(change,dels@d,done)
170 : cchiw 2452 | distribute(change,[],[],e,done)=(change,[],done@e)
171 :     | distribute(change,E.Delta(i,j)::ds,dels,E.Tensor(id,[tx])::es,done)=
172 :     if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Tensor(id,[i])])
173 :     else distribute(change,ds,dels@[E.Delta(i,j)],E.Tensor(id,[tx])::es,done)
174 :     | distribute(change,E.Delta(i,j)::ds,dels,E.Field(id,[tx])::es,done)=
175 :     if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Field(id,[i])])
176 :     else distribute(change,ds,dels@[E.Delta(i,j)],E.Field(id,[tx])::es,done)
177 :     | distribute(change,d,dels,e::es,done)=distribute(change,dels@d,[],es,done@[e])
178 : cchiw 2449
179 :     val (dels,eps,es)=findDeltas([],[],p)
180 :     val (change,dels',done)=distribute([],dels,[],es,[])
181 :     val index=rmIndex(change,[],c)
182 :    
183 :     in
184 :     (change, E.Sum(index,E.Prod (eps@dels'@done)))
185 :     end
186 :    
187 : cchiw 2452 fun mkApply2(E.Apply(d,e))=(case e
188 :     of E.Tensor(a,[])=>(1,E.Const 0.0)
189 :     | E.Const _ =>(1,E.Const 0.0)
190 :     | E.Add l => (1,E.Add(List.map (fn e => E.Apply(d, e)) l))
191 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(d, e2), E.Apply(d, e3)))
192 :     | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(d,e)])
193 :     | E.Prod [e1]=>(1,E.Apply(d,e1))
194 :     | E.Prod es=> (let
195 :     fun prod [e1] =E.Apply(d,e1)
196 :     | prod(e1::e2)=(let
197 :     val l= prod(e2) val m= E.Prod[e1,l]
198 :     val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr
199 :     in E.Add[a,m]
200 :     end)
201 :     in (1,prod es) end)
202 :     |_=>(0,E.Apply(d,e))
203 :     (* end case*))
204 :    
205 :     fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(case e
206 :     of E.Const _=>(1,E.Const 0.0)
207 :     | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l))
208 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(E.Partial d, e2)), E.Sum(c,E.Apply(E.Partial d, e3))))
209 :     | E.Prod(E.Tensor(a,[])::e2)=>(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,E.Prod e2))])
210 :     | E.Prod [e1]=>(1,E.Sum(c,E.Apply(E.Partial d,e1)))
211 :     | E.Prod es =>(let
212 :     fun prod (change,rest, sum,partial,[]) = (change,E.Sum(sum,E.Apply(E.Partial partial,E.Prod rest)))
213 :     | prod (change,rest, sum,partial,E.Epsilon(i,j,k)::ps)= let
214 :     fun matchprod(2,_,_,_)= 1 (*matched 2*)
215 :     | matchprod(num,_,_,[])=0
216 :     | matchprod(0,_,_,[eps])=0
217 :     | matchprod(num,[],rest,eps::epsx)=
218 :     matchprod(num,rest,[],epsx)
219 :     | matchprod(num,E.V p::px,rest,eps::epsx)=
220 :     if(p=eps) then matchprod(num+1,px,rest,epsx)
221 :     else matchprod(num,px,rest@[E.V p], eps::epsx)
222 :     | matchprod(num,p::px,rest,eps)=
223 :     matchprod(num,px,rest,eps)
224 :    
225 :     val change'= matchprod(0,d,[],[i,j,k])
226 :     in (case change'
227 :     of 1 => (1,E.Const 0.0)
228 :     | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps))
229 :     end
230 :     | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let
231 :     fun applyDelPartial([],_)=(0,[])
232 :     | applyDelPartial(p::px,r)=
233 :     if(j=p) then (1,r@[i]@px)
234 :     else applyDelPartial(px,r@[p])
235 :    
236 :     val (change',px)=applyDelPartial(d,[])
237 :    
238 :     in (case change'
239 :     of 1 => (let val index=rmIndex([j],[],sum)
240 :     in prod(1,rest, index,px, ps) end )
241 :     | _ => prod(change,rest@[E.Delta(i,j)], sum,partial, ps)
242 :     (*end case*)) end
243 :    
244 :     | prod (change,rest,sum, partial,e::es)= prod(change,rest@[e],sum,partial,es)
245 :    
246 :     val (change,exp) = prod(0,[],c, d, es)
247 :    
248 :     in
249 :     (change,exp)
250 :     end)
251 :     | _=>(0,E.Sum(c,E.Apply(E.Partial d,e)))
252 :     (* end case*))
253 :    
254 :     (*
255 :     E.Sum(c,Apply(d,e))
256 :     try E.Sum(c,e)=> E.Sum(c',e')
257 :     ==> E.Sum(c',E.Apply(d,e'))
258 :     E.Apply(d,e')=> E.Apply(d',e'')
259 :     ==>E.Sum(c',E.Apply(d',e'')
260 :     *)
261 :    
262 : cchiw 2397 (*Apply normalize to each term in product list
263 :     or Apply normalize to tail of each list*)
264 :     fun normalize (Ein.EIN{params, index, body}) = let
265 :     val changed = ref false
266 :     fun rewriteBody body = (case body
267 :     of E.Const _=> body
268 :     | E.Tensor _ =>body
269 :     | E.Field _=> body
270 : cchiw 2437 | E.Kernel _ =>body
271 : cchiw 2397 | E.Delta _ => body
272 : cchiw 2437 | E.Value _ =>body
273 : cchiw 2397 | E.Epsilon _=>body
274 : cchiw 2449
275 : cchiw 2437 | E.Neg e => E.Neg(rewriteBody e)
276 : cchiw 2452 | E.Add es => let val (change,body')= mkAdd(List.map rewriteBody es)
277 :     in if (change=1) then ( changed:=true;body') else body' end
278 : cchiw 2437 | E.Sub (a,b)=> E.Sub(rewriteBody a, rewriteBody b)
279 :     | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b)
280 : cchiw 2397 | E.Partial _=>body
281 : cchiw 2437 | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha)
282 :     | E.Probe(u,v)=> E.Probe(rewriteBody u, rewriteBody v)
283 :     | E.Image es => E.Image(List.map rewriteBody es)
284 :    
285 : cchiw 2449 (*Product*)
286 :     | E.Prod [e1] => rewriteBody e1
287 : cchiw 2397 | E.Prod(e1::(E.Add(e2))::e3)=>
288 : cchiw 2449 (changed := true; E.Add(List.map (fn e=> E.Prod([e1, e]@e3)) e2))
289 : cchiw 2397 | E.Prod(e1::(E.Sub(e2,e3))::e4)=>
290 : cchiw 2449 (changed :=true; E.Sub(E.Prod([e1, e2]@e4), E.Prod([e1,e3]@e4 )))
291 :     | E.Prod [E.Partial r1,E.Conv(f,deltas)]=>
292 :     (changed :=true;E.Conv(f,deltas@r1))
293 :     | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=>
294 : cchiw 2452 (changed:=true;
295 :     let val (change,e)=mkProd([E.Conv(f,deltas@r1)]@ps)
296 :     in e end)
297 :     | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=>
298 :     if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0))
299 :     else body
300 :    
301 :     | E.Prod(E.Partial r1::E.Partial r2::p)=>
302 :     (changed:=true;E.Prod([E.Partial(r1@r2)]@p))
303 : cchiw 2449 | E.Prod(e::es)=>let
304 :     val e'=rewriteBody e
305 :     val e2=rewriteBody(E.Prod es)
306 : cchiw 2452 val(a,b)=(case e2 of E.Prod p'=> mkProd([e']@p')
307 :     |_=>mkProd [e',e2])
308 :     in b
309 : cchiw 2449 end
310 : cchiw 2437
311 : cchiw 2449 (*Apply*)
312 : cchiw 2452 | E.Apply(E.Partial [],e)=> e
313 :     | E.Apply(E.Partial p, e)=>let
314 :     val body'=E.Apply(E.Partial p, rewriteBody e)
315 :     val (c, e')=mkApply2(body')
316 :     in (case c of 1=>(changed:=true;e')
317 :     | _ =>e') end
318 : cchiw 2449 | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2)
319 : cchiw 2437
320 :    
321 :    
322 : cchiw 2449 (* Sum *)
323 : cchiw 2452 | E.Sum([],e)=> (changed:=true;rewriteBody e)
324 :     | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
325 : cchiw 2449 | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
326 :     | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
327 :     let val (i,e,rest)=epsToDels(body)
328 :     in (case (i, e,rest)
329 : cchiw 2452 of (1,[e1],_) =>(changed:=true;e1)
330 : cchiw 2449 |(0,eps,[])=>body
331 :     |(0,eps,rest)=>(let
332 :     val p'=rewriteBody(E.Prod rest)
333 :     val p''= (case p' of E.Prod p=>p |e=>[e])
334 : cchiw 2452 val(a,b)= mkProd (eps@p'')
335 :     in E.Sum(c,b) end
336 : cchiw 2449 )
337 : cchiw 2452 |_=>body)
338 :     end
339 : cchiw 2449 | E.Sum(c, E.Prod(E.Delta d::es))=>let
340 : cchiw 2452 val (change,a)=reduceDelta(body)
341 :     val (change',body')=(case a
342 :     of E.Prod p=> mkProd p
343 :     |_=> (0,a))
344 : cchiw 2449 in (case change of []=>body'|_=>(changed:=true;body')) end
345 : cchiw 2452 | E.Sum(c,E.Apply(d,e))=>let
346 :     val(c',e')=mkSumApply2(body)
347 :     in (case c' of 1=>(changed:=true;e') |_=>e')
348 :     end
349 : cchiw 2449 | E.Sum(c,e)=>E.Sum(c,rewriteBody e)
350 : cchiw 2437
351 : cchiw 2397 (*end case*))
352 :    
353 :     fun loop body = let
354 :     val body' = rewriteBody body
355 :     in
356 :     if !changed
357 : cchiw 2452 then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body')
358 : cchiw 2397 else body'
359 :     end
360 :     val b = loop body
361 :     in
362 :     ((Ein.EIN{params=params, index=index, body=b}))
363 :     end
364 : cchiw 2448 end
365 : cchiw 2397
366 :    
367 :     end (* local *)

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