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

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