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 2460 - (view) (download)

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 : cchiw 2460
51 : cchiw 2452
52 :    
53 :     fun rmEpsIndex(_,_,[])=[]
54 :     | rmEpsIndex([],[],cs)=cs
55 :     | rmEpsIndex([],m ,e1::cs)=[e1]@rmEpsIndex(m,[],cs)
56 :     | rmEpsIndex(i::ix,rest ,(E.V c)::cs)=
57 :     if(i=c) then rmEpsIndex(rest@ix,[],cs)
58 :     else rmEpsIndex(ix,rest@[i],(E.V c)::cs)
59 :    
60 : cchiw 2397
61 : cchiw 2452 (* Transform eps to deltas*)
62 : cchiw 2397 fun epsToDels(E.Sum(count,E.Prod e))= let
63 : cchiw 2449 fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,eps,e3)=
64 : cchiw 2397 let
65 : cchiw 2449
66 :     (*Function is called when eps are being changed to deltas*)
67 :     fun createDeltas(i,s,t,u,v, e3)= let
68 :    
69 :     (*remove index from original index list*)
70 :     (*currrent, left, sumIndex*)
71 :    
72 : cchiw 2452 val s'= rmEpsIndex([i,s,t,u,v],[],count)
73 : cchiw 2449 val s''=[E.V s, E.V t ,E.V u, E.V v]
74 :     val deltas= E.Sub(
75 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)),
76 :     E.Sum(s'',E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3)))
77 :    
78 : cchiw 2460 in (case (eps,es,s')
79 :     of ([],[],[]) =>(1,deltas)
80 :     |([],_,[]) =>(1,E.Prod( es@[deltas]))
81 :     |([],[],_)=>(1,E.Sum(s',deltas))
82 :     |([],_,_)=>(1,E.Sum(s',E.Prod(es@[deltas])))
83 :     |(_,_,[])=>(1,E.Prod(eps@es@[deltas]))
84 :     |_ =>(1, E.Sum(s', E.Prod(eps@es@[deltas])))
85 : cchiw 2449 )
86 :     end
87 :    
88 :     in if(a=d) then createDeltas(a,b,c,e,f, e3)
89 :     else if(a=e) then createDeltas(a,b,c,f,d, e3)
90 :     else if(a=f) then createDeltas(a,b,c,d,e, e3)
91 :     else if(b=d) then createDeltas(b,c,a,e,f, e3)
92 :     else if(b=e) then createDeltas(b,c,a,f,d,e3)
93 :     else if(b=f) then createDeltas(b,c,a,d,e,e3)
94 :     else if(c=d) then createDeltas(c,a,b,e,f,e3)
95 :     else if(c=e) then createDeltas(c,a,b,f,d,e3)
96 :     else if(c=f) then createDeltas(c,a,b,d,e,e3)
97 :     else (0,E.Const 0.0)
98 : cchiw 2397 end
99 :     fun findeps(e,[])= (e,[])
100 :     | findeps(e,(E.Epsilon eps)::es)= findeps(e@[E.Epsilon eps],es)
101 :     | findeps(e,es)= (e, es)
102 : cchiw 2449
103 :    
104 :     fun dist([],eps,rest)=(0,eps,rest)
105 :     | dist([e],eps,rest)=(0,eps@[e],rest)
106 :     | dist(c1::current,eps,rest)=let
107 :     val(i, exp)= doubleEps(c1::current,eps,rest)
108 :     in (case i of 1=>(i,[exp],[E.Const 2.0])
109 :     |_=> dist(current, eps@[c1],rest))
110 : cchiw 2452 end
111 : cchiw 2449
112 :     val (es,rest)=findeps([],e)
113 :    
114 :     in
115 :     dist(es,[],rest)
116 :     end
117 : cchiw 2397
118 :    
119 : cchiw 2452 fun rmIndex(_,_,[])=[]
120 :     | rmIndex([],[],cs)=cs
121 :     | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
122 :     | rmIndex(i::ix,rest ,c::cs)=
123 :     if(i=c) then rmIndex(rest@ix,[],cs)
124 :     else rmIndex(ix,rest@[i],c::cs)
125 :    
126 :     (* Apply deltas to tensors/fields*)
127 : cchiw 2449 fun reduceDelta(E.Sum(c,E.Prod p))=let
128 :    
129 :     fun findDeltas(dels,rest,E.Delta d::es)= findDeltas(dels@[E.Delta d], rest, es)
130 :     | findDeltas(dels,rest,E.Epsilon eps::es)=findDeltas(dels,rest@[E.Epsilon eps],es)
131 :     | findDeltas(dels,rest,es)= (dels,rest,es)
132 :    
133 : cchiw 2452
134 : cchiw 2449 fun distribute(change,d,dels,[],done)=(change,dels@d,done)
135 : cchiw 2452 | distribute(change,[],[],e,done)=(change,[],done@e)
136 :     | distribute(change,E.Delta(i,j)::ds,dels,E.Tensor(id,[tx])::es,done)=
137 :     if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Tensor(id,[i])])
138 :     else distribute(change,ds,dels@[E.Delta(i,j)],E.Tensor(id,[tx])::es,done)
139 :     | distribute(change,E.Delta(i,j)::ds,dels,E.Field(id,[tx])::es,done)=
140 :     if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Field(id,[i])])
141 :     else distribute(change,ds,dels@[E.Delta(i,j)],E.Field(id,[tx])::es,done)
142 :     | distribute(change,d,dels,e::es,done)=distribute(change,dels@d,[],es,done@[e])
143 : cchiw 2449
144 :     val (dels,eps,es)=findDeltas([],[],p)
145 :     val (change,dels',done)=distribute([],dels,[],es,[])
146 :     val index=rmIndex(change,[],c)
147 :    
148 :     in
149 :     (change, E.Sum(index,E.Prod (eps@dels'@done)))
150 :     end
151 :    
152 : cchiw 2458
153 :     fun mkApplySum(E.Apply(E.Partial d,E.Sum(c,e)))=(print "apply sum";case e
154 : cchiw 2452 of E.Tensor(a,[])=>(1,E.Const 0.0)
155 :     | E.Const _ =>(1,E.Const 0.0)
156 : cchiw 2458 | E.Add l => (1,E.Add(List.map (fn e => E.Apply(E.Partial d, E.Sum(c,e))) l))
157 :     | 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))))
158 :    
159 :     | E.Prod [e1]=>(1,E.Apply(E.Partial d,E.Sum(c,e1)))
160 :     | E.Prod(E.Tensor(a,[])::e1::[])=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Sum(c,e1))])
161 :    
162 :     | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Sum(c,E.Prod e2))])
163 : cchiw 2460
164 :     | E.Prod es=>(let
165 : cchiw 2458 fun prod [e1] =E.Apply(E.Partial d,e1)
166 : cchiw 2460 | prod (E.Epsilon eps1::es) = (E.Apply(E.Partial d, E.Prod (E.Epsilon eps1::es)))
167 :     | prod (E.Delta e1::es) = (E.Apply(E.Partial d, E.Prod (E.Delta e1::es)))
168 :     | prod (E.Prod e1::es)=prod(e1@es)
169 : cchiw 2452 | prod(e1::e2)=(let
170 : cchiw 2460 val l= prod(e2)
171 :     val (_, a)= mkProd[e1,l]
172 :     val lr=e2 @[E.Apply(E.Partial d,e1)]
173 :     val(_,b) =mkProd lr
174 :     in E.Add[b,a]
175 : cchiw 2458 end)
176 : cchiw 2460 val chainrule=prod es
177 :     in (1,E.Sum(c, chainrule)) end)
178 : cchiw 2458 |_=>(0,E.Apply(E.Partial d,E.Sum(c,e)))
179 : cchiw 2452 (* end case*))
180 : cchiw 2458
181 :     fun mkApply2(E.Apply(E.Partial d,e))=(print "aa";case e
182 :     of E.Tensor(a,[])=>(1,E.Const 0.0)
183 :     | E.Const _ =>(1,E.Const 0.0)
184 :     | E.Add l => (1,E.Add(List.map (fn e => E.Apply(E.Partial d, e)) l))
185 :     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(E.Partial d, e2), E.Apply(E.Partial d, e3)))
186 :     | E.Apply(E.Partial e1,e2)=>(1,E.Apply(E.Partial(d@e1), e2))
187 :     | E.Prod [e1]=>(1,E.Apply(E.Partial d,e1))
188 :     | E.Prod(E.Tensor(a,[])::e1::[])=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,e1)])
189 :     | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Prod e2)])
190 :     | E.Prod es=> (let
191 :     fun prod [e1] =(0,E.Apply(E.Partial d,e1))
192 : cchiw 2460 | prod (E.Epsilon eps1::es) = (0,E.Apply(E.Partial d, E.Prod (E.Epsilon eps1::es)))
193 :     | prod (E.Delta e1::es) = (0,E.Apply(E.Partial d, E.Prod (E.Delta e1::es)))
194 :     | prod (E.Prod e1::es)=prod(e1@es)
195 : cchiw 2458 | prod(E.Tensor t::e2)=(let
196 : cchiw 2460 val (_,l)= prod(e2) val m= E.Prod[E.Tensor t,l]
197 : cchiw 2458 val lr=e2 @[E.Apply(E.Partial d,E.Tensor t)] val(b,a) =mkProd lr
198 :     in (1,E.Add[a,m])
199 :     end)
200 :     | prod(E.Field f::e2)=(let
201 : cchiw 2460 val (_,l)= prod(e2) val m= E.Prod[E.Field f,l]
202 : cchiw 2458 val lr=e2 @[E.Apply(E.Partial d,E.Field f)] val(b,a) =mkProd lr
203 :     in (1,E.Add[a,m])
204 :     end)
205 :     | prod e = (0,E.Apply(E.Partial d, E.Prod e))
206 : cchiw 2460
207 : cchiw 2458
208 :     val (a,b)= prod es
209 :    
210 :     in (a, b) end)
211 :     |_=>(0,E.Apply(E.Partial d,e))
212 :     (* end case*))
213 : cchiw 2452
214 : cchiw 2458 fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(print "in here ";case e
215 : cchiw 2452 of E.Const _=>(1,E.Const 0.0)
216 : cchiw 2458 | E.Tensor(_,[])=> (1,E.Const 0.0)
217 :     | E.Field _=>(0,E.Sum(c,E.Apply(E.Partial d,e)))
218 :     | E.Apply(E.Partial e1,e2)=>(1,E.Sum(c,E.Apply(E.Partial(d@e1),e2)))
219 :    
220 : cchiw 2452 | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l))
221 : cchiw 2458 | E.Sub(e2, e3) =>
222 :     (*(0,E.Sub(e2,e3))
223 :     *)
224 :     (print "sub";(1, E.Sub(E.Sum(c,E.Apply(E.Partial d, e2)), E.Sum(c,E.Apply(E.Partial d, e3)))))
225 :    
226 :     | E.Prod [e1]=>(print "one";(1,E.Sum(c,E.Apply(E.Partial d,e1))))
227 :    
228 :    
229 :     | E.Prod(E.Tensor(a,[])::e2::[])=>("in scalar";(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,e2))]))
230 :    
231 :     | 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))]))
232 :    
233 :     | E.Prod es =>(print "in prod";let
234 : cchiw 2452 fun prod (change,rest, sum,partial,[]) = (change,E.Sum(sum,E.Apply(E.Partial partial,E.Prod rest)))
235 :     | prod (change,rest, sum,partial,E.Epsilon(i,j,k)::ps)= let
236 :     fun matchprod(2,_,_,_)= 1 (*matched 2*)
237 :     | matchprod(num,_,_,[])=0
238 :     | matchprod(0,_,_,[eps])=0
239 :     | matchprod(num,[],rest,eps::epsx)=
240 :     matchprod(num,rest,[],epsx)
241 :     | matchprod(num,E.V p::px,rest,eps::epsx)=
242 : cchiw 2460 if(p=eps) then (matchprod(num+1,rest@px,[],epsx))
243 : cchiw 2452 else matchprod(num,px,rest@[E.V p], eps::epsx)
244 :     | matchprod(num,p::px,rest,eps)=
245 :     matchprod(num,px,rest,eps)
246 :    
247 :     val change'= matchprod(0,d,[],[i,j,k])
248 :     in (case change'
249 :     of 1 => (1,E.Const 0.0)
250 : cchiw 2458 | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps)
251 :     (*end case*))
252 : cchiw 2452 end
253 :     | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let
254 :     fun applyDelPartial([],_)=(0,[])
255 :     | applyDelPartial(p::px,r)=
256 :     if(j=p) then (1,r@[i]@px)
257 :     else applyDelPartial(px,r@[p])
258 :    
259 :     val (change',px)=applyDelPartial(d,[])
260 :    
261 :     in (case change'
262 :     of 1 => (let val index=rmIndex([j],[],sum)
263 :     in prod(1,rest, index,px, ps) end )
264 :     | _ => prod(change,rest@[E.Delta(i,j)], sum,partial, ps)
265 :     (*end case*)) end
266 :    
267 :     | prod (change,rest,sum, partial,e::es)= prod(change,rest@[e],sum,partial,es)
268 :    
269 :     val (change,exp) = prod(0,[],c, d, es)
270 :    
271 :     in
272 :     (change,exp)
273 :     end)
274 : cchiw 2458 | _=>(print "nope";(0,E.Sum(c,E.Apply(E.Partial d,e))))
275 : cchiw 2452 (* end case*))
276 :    
277 :     (*
278 :     E.Sum(c,Apply(d,e))
279 :     try E.Sum(c,e)=> E.Sum(c',e')
280 :     ==> E.Sum(c',E.Apply(d,e'))
281 :     E.Apply(d,e')=> E.Apply(d',e'')
282 :     ==>E.Sum(c',E.Apply(d',e'')
283 :     *)
284 :    
285 : cchiw 2397 (*Apply normalize to each term in product list
286 :     or Apply normalize to tail of each list*)
287 :     fun normalize (Ein.EIN{params, index, body}) = let
288 : cchiw 2458
289 : cchiw 2397 val changed = ref false
290 : cchiw 2458
291 : cchiw 2397 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 : cchiw 2452 | E.Add es => let val (change,body')= mkAdd(List.map rewriteBody es)
302 :     in if (change=1) then ( changed:=true;body') else body' end
303 : cchiw 2437 | 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 : cchiw 2458 (changed:=true;E.Conv(f,deltas@r1))
318 : cchiw 2449 | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=>
319 : cchiw 2452 (changed:=true;
320 :     let val (change,e)=mkProd([E.Conv(f,deltas@r1)]@ps)
321 :     in e end)
322 :     | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=>
323 :     if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0))
324 :     else body
325 : cchiw 2458 | E.Prod [E.Partial r1, E.Tensor(_,[])]=> (changed:=true;E.Const(0.0))
326 : cchiw 2452 | E.Prod(E.Partial r1::E.Partial r2::p)=>
327 :     (changed:=true;E.Prod([E.Partial(r1@r2)]@p))
328 : cchiw 2458 | E.Prod [E.Partial _, _] =>body
329 :    
330 :     | E.Prod (E.Partial p1::es)=> (let
331 :     fun prod [e1] =E.Apply(E.Partial p1,e1)
332 :     | prod(e1::e2)=(let
333 :     val l= prod(e2) val m= E.Prod[e1,l]
334 :     val lr=e2 @[E.Apply(E.Partial p1,e1)] val(b,a) =mkProd lr
335 :     in E.Add[a,m]
336 :     end)
337 :     in (changed:=true;prod es) end)
338 :    
339 : cchiw 2449 | E.Prod(e::es)=>let
340 :     val e'=rewriteBody e
341 :     val e2=rewriteBody(E.Prod es)
342 : cchiw 2452 val(a,b)=(case e2 of E.Prod p'=> mkProd([e']@p')
343 :     |_=>mkProd [e',e2])
344 :     in b
345 : cchiw 2449 end
346 : cchiw 2437
347 : cchiw 2449 (*Apply*)
348 : cchiw 2458
349 :     | E.Apply(E.Partial d,E.Sum(c,e))=>let
350 :     val(c,e')=mkApplySum(E.Apply(E.Partial d,E.Sum(c, rewriteBody e)))
351 : cchiw 2460 val e''=(case e'
352 :     of E.Apply(d,E.Sum s)=>E.Apply(d,rewriteBody(E.Sum s))
353 :     |_=> e')
354 :     in (print "bb";case c of 1=>(changed:=true;e'')
355 :     |_=> e'')end
356 : cchiw 2452 | E.Apply(E.Partial [],e)=> e
357 : cchiw 2458
358 : cchiw 2452 | E.Apply(E.Partial p, e)=>let
359 :     val body'=E.Apply(E.Partial p, rewriteBody e)
360 :     val (c, e')=mkApply2(body')
361 :     in (case c of 1=>(changed:=true;e')
362 :     | _ =>e') end
363 : cchiw 2449 | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2)
364 : cchiw 2437
365 :    
366 :    
367 : cchiw 2449 (* Sum *)
368 : cchiw 2452 | E.Sum([],e)=> (changed:=true;rewriteBody e)
369 :     | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
370 : cchiw 2449 | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
371 : cchiw 2458 | E.Sum(c,E.Sub(e1,e2))=>(changed:=true; E.Sub(E.Sum(c,e1),E.Sum(c,e2)))
372 : cchiw 2449 | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
373 :     let val (i,e,rest)=epsToDels(body)
374 : cchiw 2460 in (print "eps to dels \n ";case (i, e,rest)
375 :     of (1,[e1],r) =>(print "changed\n";changed:=true;e1)
376 :     |(0,eps,[])=>(print "non";body)
377 : cchiw 2449 |(0,eps,rest)=>(let
378 :     val p'=rewriteBody(E.Prod rest)
379 :     val p''= (case p' of E.Prod p=>p |e=>[e])
380 : cchiw 2452 val(a,b)= mkProd (eps@p'')
381 :     in E.Sum(c,b) end
382 : cchiw 2449 )
383 : cchiw 2452 |_=>body)
384 :     end
385 : cchiw 2449 | E.Sum(c, E.Prod(E.Delta d::es))=>let
386 : cchiw 2452 val (change,a)=reduceDelta(body)
387 :     val (change',body')=(case a
388 :     of E.Prod p=> mkProd p
389 :     |_=> (0,a))
390 : cchiw 2449 in (case change of []=>body'|_=>(changed:=true;body')) end
391 : cchiw 2458
392 :     | E.Sum(c,E.Apply(E.Partial _,e))=>let
393 :     val (change,exp)=mkSumApply2(body)
394 :     val exp'=(case exp
395 :     of E.Const c => E.Const c
396 :     | E.Sum(c',E.Apply(d',e')) => (let
397 :     val s'=rewriteBody(E.Sum(c',e'))
398 :     in (case s'
399 : cchiw 2460 of E.Sum([],e'')=> rewriteBody (E.Apply(d',e''))
400 :     | E.Sum(s'',e'') => E.Sum(s'',rewriteBody(E.Apply(d',e'')))
401 : cchiw 2458 | _ => E.Apply(d',s'))
402 :    
403 :     end)
404 :    
405 :    
406 :     | _ =>exp
407 :     (* end case *))
408 :    
409 :     in (case change of 1=>(changed:=true;exp') |_=>exp')
410 : cchiw 2452 end
411 : cchiw 2458
412 :    
413 : cchiw 2449 | E.Sum(c,e)=>E.Sum(c,rewriteBody e)
414 : cchiw 2437
415 : cchiw 2397 (*end case*))
416 :    
417 :     fun loop body = let
418 :     val body' = rewriteBody body
419 :     in
420 :     if !changed
421 : cchiw 2460 then (changed := false; loop body')
422 :     else body'
423 : cchiw 2397 end
424 :     val b = loop body
425 :     in
426 :     ((Ein.EIN{params=params, index=index, body=b}))
427 :     end
428 : cchiw 2448 end
429 : cchiw 2397
430 :    
431 :     end (* local *)

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