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 2458 - (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 2458 structure O =OrderEin
9 : cchiw 2397 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 : cchiw 2458 | E.Prod[E.Tensor(a,[]), e2]=> (1, E.Prod[ E.Tensor(a,[]), E.Sum(c,E.Apply(d, e2))] )
76 :     | E.Prod((E.Tensor(a,[]))::e2)=> (1, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )
77 : cchiw 2397 | 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 2458
188 :     fun mkApplySum(E.Apply(E.Partial d,E.Sum(c,e)))=(print "apply sum";case e
189 : cchiw 2452 of E.Tensor(a,[])=>(1,E.Const 0.0)
190 :     | E.Const _ =>(1,E.Const 0.0)
191 : cchiw 2458 | E.Add l => (1,E.Add(List.map (fn e => E.Apply(E.Partial d, E.Sum(c,e))) l))
192 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(E.Partial d, E.Sum(c,e2)), E.Apply(E.Partial d, E.Sum(c,e3))))
193 :    
194 :     | E.Prod [e1]=>(1,E.Apply(E.Partial d,E.Sum(c,e1)))
195 :     | E.Prod(E.Tensor(a,[])::e1::[])=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Sum(c,e1))])
196 :    
197 :     | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Sum(c,E.Prod e2))])
198 :     (* | E.Prod es=> (let
199 :     fun prod [e1] =E.Apply(E.Partial d,e1)
200 : cchiw 2452 | prod(e1::e2)=(let
201 :     val l= prod(e2) val m= E.Prod[e1,l]
202 : cchiw 2458 val lr=e2 @[E.Apply(E.Partial d,e1)] val(b,a) =mkProd lr
203 : cchiw 2452 in E.Add[a,m]
204 : cchiw 2458 end)
205 :     in (1,prod es) end)*)
206 :     |_=>(0,E.Apply(E.Partial d,E.Sum(c,e)))
207 : cchiw 2452 (* end case*))
208 : cchiw 2458
209 :     fun mkApply2(E.Apply(E.Partial d,e))=(print "aa";case e
210 :     of E.Tensor(a,[])=>(1,E.Const 0.0)
211 :     | E.Const _ =>(1,E.Const 0.0)
212 :     | E.Add l => (1,E.Add(List.map (fn e => E.Apply(E.Partial d, e)) l))
213 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(E.Partial d, e2), E.Apply(E.Partial d, e3)))
214 :     | E.Apply(E.Partial e1,e2)=>(1,E.Apply(E.Partial(d@e1), e2))
215 :     | E.Prod [e1]=>(1,E.Apply(E.Partial d,e1))
216 :     | E.Prod(E.Tensor(a,[])::e1::[])=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,e1)])
217 :     | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Prod e2)])
218 :     | E.Prod es=> (let
219 :     fun prod [e1] =(0,E.Apply(E.Partial d,e1))
220 :    
221 :     | prod(E.Tensor t::e2)=(let
222 :     val (change,l)= prod(e2) val m= E.Prod[E.Tensor t,l]
223 :     val lr=e2 @[E.Apply(E.Partial d,E.Tensor t)] val(b,a) =mkProd lr
224 :     in (1,E.Add[a,m])
225 :     end)
226 :     | prod(E.Field f::e2)=(let
227 :     val (change,l)= prod(e2) val m= E.Prod[E.Field f,l]
228 :     val lr=e2 @[E.Apply(E.Partial d,E.Field f)] val(b,a) =mkProd lr
229 :     in (1,E.Add[a,m])
230 :     end)
231 :     | prod e = (0,E.Apply(E.Partial d, E.Prod e))
232 :     (*)prod (e1::e2)= E.Apply(E.Partial d, E.Prod ([e1]@e2))
233 :     *)
234 :    
235 :     val (a,b)= prod es
236 :    
237 :     in (a, b) end)
238 :     |_=>(0,E.Apply(E.Partial d,e))
239 :     (* end case*))
240 : cchiw 2452
241 : cchiw 2458 fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(print "in here ";case e
242 : cchiw 2452 of E.Const _=>(1,E.Const 0.0)
243 : cchiw 2458 | E.Tensor(_,[])=> (1,E.Const 0.0)
244 :     | E.Field _=>(0,E.Sum(c,E.Apply(E.Partial d,e)))
245 :     | E.Apply(E.Partial e1,e2)=>(1,E.Sum(c,E.Apply(E.Partial(d@e1),e2)))
246 :    
247 : cchiw 2452 | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l))
248 : cchiw 2458 | E.Sub(e2, e3) =>
249 :     (*(0,E.Sub(e2,e3))
250 :     *)
251 :     (print "sub";(1, E.Sub(E.Sum(c,E.Apply(E.Partial d, e2)), E.Sum(c,E.Apply(E.Partial d, e3)))))
252 :    
253 :     | E.Prod [e1]=>(print "one";(1,E.Sum(c,E.Apply(E.Partial d,e1))))
254 :    
255 :    
256 :     | E.Prod(E.Tensor(a,[])::e2::[])=>("in scalar";(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,e2))]))
257 :    
258 :     | E.Prod(E.Tensor(a,[])::e2)=>("in scalar";(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,E.Prod e2))]))
259 :    
260 :     | E.Prod es =>(print "in prod";let
261 : cchiw 2452 fun prod (change,rest, sum,partial,[]) = (change,E.Sum(sum,E.Apply(E.Partial partial,E.Prod rest)))
262 :     | prod (change,rest, sum,partial,E.Epsilon(i,j,k)::ps)= let
263 :     fun matchprod(2,_,_,_)= 1 (*matched 2*)
264 :     | matchprod(num,_,_,[])=0
265 :     | matchprod(0,_,_,[eps])=0
266 :     | matchprod(num,[],rest,eps::epsx)=
267 :     matchprod(num,rest,[],epsx)
268 :     | matchprod(num,E.V p::px,rest,eps::epsx)=
269 :     if(p=eps) then matchprod(num+1,px,rest,epsx)
270 :     else matchprod(num,px,rest@[E.V p], eps::epsx)
271 :     | matchprod(num,p::px,rest,eps)=
272 :     matchprod(num,px,rest,eps)
273 :    
274 :     val change'= matchprod(0,d,[],[i,j,k])
275 :     in (case change'
276 :     of 1 => (1,E.Const 0.0)
277 : cchiw 2458 | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps)
278 :     (*end case*))
279 : cchiw 2452 end
280 :     | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let
281 :     fun applyDelPartial([],_)=(0,[])
282 :     | applyDelPartial(p::px,r)=
283 :     if(j=p) then (1,r@[i]@px)
284 :     else applyDelPartial(px,r@[p])
285 :    
286 :     val (change',px)=applyDelPartial(d,[])
287 :    
288 :     in (case change'
289 :     of 1 => (let val index=rmIndex([j],[],sum)
290 :     in prod(1,rest, index,px, ps) end )
291 :     | _ => prod(change,rest@[E.Delta(i,j)], sum,partial, ps)
292 :     (*end case*)) end
293 :    
294 :     | prod (change,rest,sum, partial,e::es)= prod(change,rest@[e],sum,partial,es)
295 :    
296 :     val (change,exp) = prod(0,[],c, d, es)
297 :    
298 :     in
299 :     (change,exp)
300 :     end)
301 : cchiw 2458 | _=>(print "nope";(0,E.Sum(c,E.Apply(E.Partial d,e))))
302 : cchiw 2452 (* end case*))
303 :    
304 :     (*
305 :     E.Sum(c,Apply(d,e))
306 :     try E.Sum(c,e)=> E.Sum(c',e')
307 :     ==> E.Sum(c',E.Apply(d,e'))
308 :     E.Apply(d,e')=> E.Apply(d',e'')
309 :     ==>E.Sum(c',E.Apply(d',e'')
310 :     *)
311 :    
312 : cchiw 2397 (*Apply normalize to each term in product list
313 :     or Apply normalize to tail of each list*)
314 :     fun normalize (Ein.EIN{params, index, body}) = let
315 : cchiw 2458
316 : cchiw 2397 val changed = ref false
317 : cchiw 2458
318 : cchiw 2397 fun rewriteBody body = (case body
319 :     of E.Const _=> body
320 :     | E.Tensor _ =>body
321 :     | E.Field _=> body
322 : cchiw 2437 | E.Kernel _ =>body
323 : cchiw 2397 | E.Delta _ => body
324 : cchiw 2437 | E.Value _ =>body
325 : cchiw 2397 | E.Epsilon _=>body
326 : cchiw 2449
327 : cchiw 2437 | E.Neg e => E.Neg(rewriteBody e)
328 : cchiw 2452 | E.Add es => let val (change,body')= mkAdd(List.map rewriteBody es)
329 :     in if (change=1) then ( changed:=true;body') else body' end
330 : cchiw 2437 | E.Sub (a,b)=> E.Sub(rewriteBody a, rewriteBody b)
331 :     | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b)
332 : cchiw 2397 | E.Partial _=>body
333 : cchiw 2437 | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha)
334 :     | E.Probe(u,v)=> E.Probe(rewriteBody u, rewriteBody v)
335 :     | E.Image es => E.Image(List.map rewriteBody es)
336 :    
337 : cchiw 2449 (*Product*)
338 :     | E.Prod [e1] => rewriteBody e1
339 : cchiw 2397 | E.Prod(e1::(E.Add(e2))::e3)=>
340 : cchiw 2449 (changed := true; E.Add(List.map (fn e=> E.Prod([e1, e]@e3)) e2))
341 : cchiw 2397 | E.Prod(e1::(E.Sub(e2,e3))::e4)=>
342 : cchiw 2449 (changed :=true; E.Sub(E.Prod([e1, e2]@e4), E.Prod([e1,e3]@e4 )))
343 :     | E.Prod [E.Partial r1,E.Conv(f,deltas)]=>
344 : cchiw 2458 (changed:=true;E.Conv(f,deltas@r1))
345 : cchiw 2449 | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=>
346 : cchiw 2452 (changed:=true;
347 :     let val (change,e)=mkProd([E.Conv(f,deltas@r1)]@ps)
348 :     in e end)
349 :     | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=>
350 :     if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0))
351 :     else body
352 : cchiw 2458 | E.Prod [E.Partial r1, E.Tensor(_,[])]=> (changed:=true;E.Const(0.0))
353 : cchiw 2452 | E.Prod(E.Partial r1::E.Partial r2::p)=>
354 :     (changed:=true;E.Prod([E.Partial(r1@r2)]@p))
355 : cchiw 2458 | E.Prod [E.Partial _, _] =>body
356 :    
357 :     | E.Prod (E.Partial p1::es)=> (let
358 :     fun prod [e1] =E.Apply(E.Partial p1,e1)
359 :     | prod(e1::e2)=(let
360 :     val l= prod(e2) val m= E.Prod[e1,l]
361 :     val lr=e2 @[E.Apply(E.Partial p1,e1)] val(b,a) =mkProd lr
362 :     in E.Add[a,m]
363 :     end)
364 :     in (changed:=true;prod es) end)
365 :    
366 : cchiw 2449 | E.Prod(e::es)=>let
367 :     val e'=rewriteBody e
368 :     val e2=rewriteBody(E.Prod es)
369 : cchiw 2452 val(a,b)=(case e2 of E.Prod p'=> mkProd([e']@p')
370 :     |_=>mkProd [e',e2])
371 :     in b
372 : cchiw 2449 end
373 : cchiw 2437
374 : cchiw 2449 (*Apply*)
375 : cchiw 2458
376 :     | E.Apply(E.Partial d,E.Sum(c,e))=>let
377 :     val(c,e')=mkApplySum(E.Apply(E.Partial d,E.Sum(c, rewriteBody e)))
378 :     in (case c of 1=>(changed:=true;e')
379 :     |_=> e')end
380 : cchiw 2452 | E.Apply(E.Partial [],e)=> e
381 : cchiw 2458
382 : cchiw 2452 | E.Apply(E.Partial p, e)=>let
383 :     val body'=E.Apply(E.Partial p, rewriteBody e)
384 :     val (c, e')=mkApply2(body')
385 :     in (case c of 1=>(changed:=true;e')
386 :     | _ =>e') end
387 : cchiw 2449 | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2)
388 : cchiw 2437
389 :    
390 :    
391 : cchiw 2449 (* Sum *)
392 : cchiw 2452 | E.Sum([],e)=> (changed:=true;rewriteBody e)
393 :     | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
394 : cchiw 2449 | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
395 : cchiw 2458 | E.Sum(c,E.Sub(e1,e2))=>(changed:=true; E.Sub(E.Sum(c,e1),E.Sum(c,e2)))
396 : cchiw 2449 | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
397 :     let val (i,e,rest)=epsToDels(body)
398 :     in (case (i, e,rest)
399 : cchiw 2452 of (1,[e1],_) =>(changed:=true;e1)
400 : cchiw 2449 |(0,eps,[])=>body
401 :     |(0,eps,rest)=>(let
402 :     val p'=rewriteBody(E.Prod rest)
403 :     val p''= (case p' of E.Prod p=>p |e=>[e])
404 : cchiw 2452 val(a,b)= mkProd (eps@p'')
405 :     in E.Sum(c,b) end
406 : cchiw 2449 )
407 : cchiw 2452 |_=>body)
408 :     end
409 : cchiw 2449 | E.Sum(c, E.Prod(E.Delta d::es))=>let
410 : cchiw 2452 val (change,a)=reduceDelta(body)
411 :     val (change',body')=(case a
412 :     of E.Prod p=> mkProd p
413 :     |_=> (0,a))
414 : cchiw 2449 in (case change of []=>body'|_=>(changed:=true;body')) end
415 : cchiw 2458
416 :     | E.Sum(c,E.Apply(E.Partial _,e))=>let
417 :     val (change,exp)=mkSumApply2(body)
418 :     val exp'=(case exp
419 :     of E.Const c => E.Const c
420 :     | E.Sum(c',E.Apply(d',e')) => (let
421 :     val s'=rewriteBody(E.Sum(c',e'))
422 :     in (case s'
423 :     of E.Sum([],e'')=>E.Apply(d',e'')
424 :     | E.Sum(s'',e'') => E.Sum(s'',E.Apply(d',e''))
425 :     | _ => E.Apply(d',s'))
426 :    
427 :     end)
428 :    
429 :    
430 :     | _ =>exp
431 :     (* end case *))
432 :    
433 :     in (case change of 1=>(changed:=true;exp') |_=>exp')
434 : cchiw 2452 end
435 : cchiw 2458
436 :    
437 : cchiw 2449 | E.Sum(c,e)=>E.Sum(c,rewriteBody e)
438 : cchiw 2437
439 : cchiw 2397 (*end case*))
440 :    
441 :     fun loop body = let
442 :     val body' = rewriteBody body
443 :     in
444 :     if !changed
445 : cchiw 2452 then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body')
446 : cchiw 2458 else (P.printbody(body');body')
447 : cchiw 2397 end
448 :     val b = loop body
449 :     in
450 :     ((Ein.EIN{params=params, index=index, body=b}))
451 :     end
452 : cchiw 2448 end
453 : cchiw 2397
454 :    
455 :     end (* local *)

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