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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2457, Tue Oct 8 19:14:09 2013 UTC revision 2458, Tue Oct 8 19:42:58 2013 UTC
# Line 5  Line 5 
5    
6      structure E = Ein      structure E = Ein
7      structure P=Printer      structure P=Printer
8        structure O =OrderEin
9      in      in
10    
11    
# Line 72  Line 72 
72      | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l))      | 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))))      | 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))      | 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))]  )      | 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)=>  (0, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )      | E.Prod((E.Tensor(a,[]))::e2)=>  (1, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )
77      | E.Prod es =>   (let      | E.Prod es =>   (let
78          fun prod [e] = (E.Apply(d, e))          fun prod [e] = (E.Apply(d, e))
79          | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]          | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]
# Line 184  Line 184 
184         (change, E.Sum(index,E.Prod (eps@dels'@done)))         (change, E.Sum(index,E.Prod (eps@dels'@done)))
185    end    end
186    
187  fun mkApply2(E.Apply(d,e))=(case e  
188    fun mkApplySum(E.Apply(E.Partial d,E.Sum(c,e)))=(print "apply sum";case e
189      of E.Tensor(a,[])=>(1,E.Const 0.0)      of E.Tensor(a,[])=>(1,E.Const 0.0)
190      | E.Const _ =>(1,E.Const 0.0)      | E.Const _ =>(1,E.Const 0.0)
191      | E.Add l => (1,E.Add(List.map (fn e => E.Apply(d, e)) l))      | 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(d, e2), E.Apply(d, e3)))      | 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      | E.Prod(E.Tensor(a,[])::e2)=>(1,E.Prod[E.Tensor(a,[]),E.Apply(d,e)])  
194      | E.Prod [e1]=>(1,E.Apply(d,e1))      | E.Prod [e1]=>(1,E.Apply(E.Partial d,E.Sum(c,e1)))
195      | E.Prod es=> (let      | E.Prod(E.Tensor(a,[])::e1::[])=>(1,E.Prod[E.Tensor(a,[]),E.Apply(E.Partial d,E.Sum(c,e1))])
196          fun prod [e1] =E.Apply(d,e1)  
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          | prod(e1::e2)=(let          | prod(e1::e2)=(let
201              val l= prod(e2) val m= E.Prod[e1,l]              val l= prod(e2) val m= E.Prod[e1,l]
202              val lr=e2 @[E.Apply(d,e1)] val(b,a) =mkProd lr              val lr=e2 @[E.Apply(E.Partial d,e1)] val(b,a) =mkProd lr
203              in  E.Add[a,m]              in  E.Add[a,m]
204              end)              end)
205          in (1,prod es) end)          in (1,prod es) end)*)
206      |_=>(0,E.Apply(d,e))      |_=>(0,E.Apply(E.Partial d,E.Sum(c,e)))
207        (* end case*))
208    
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*))      (* end case*))
240    
241  fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(case e  fun mkSumApply2(E.Sum(c,E.Apply(E.Partial d,e)))=(print "in here ";case e
242      of E.Const _=>(1,E.Const 0.0)      of E.Const _=>(1,E.Const 0.0)
243        | 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      | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l))      | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(E.Partial d, e))) l))
248      | 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))))      | E.Sub(e2, e3) =>
249      | E.Prod(E.Tensor(a,[])::e2)=>(1, E.Prod[E.Tensor(a,[]),E.Sum(c,E.Apply(E.Partial d,E.Prod e2))])                  (*(0,E.Sub(e2,e3))
250      | E.Prod [e1]=>(1,E.Sum(c,E.Apply(E.Partial d,e1)))                  *)
251      | E.Prod es =>(let                  (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          fun prod (change,rest, sum,partial,[]) = (change,E.Sum(sum,E.Apply(E.Partial partial,E.Prod rest)))          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          | prod (change,rest, sum,partial,E.Epsilon(i,j,k)::ps)= let
263              fun matchprod(2,_,_,_)= 1 (*matched 2*)              fun matchprod(2,_,_,_)= 1 (*matched 2*)
# Line 225  Line 274 
274              val change'= matchprod(0,d,[],[i,j,k])              val change'= matchprod(0,d,[],[i,j,k])
275              in (case change'              in (case change'
276                  of 1 => (1,E.Const 0.0)                  of 1 => (1,E.Const 0.0)
277                  | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps))                  | _ =>prod(change,rest@[E.Epsilon(i,j,k)],sum,partial,ps)
278                    (*end case*))
279              end              end
280          | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let          | prod (change,rest, sum,partial,E.Delta(i,j)::ps)=let
281              fun applyDelPartial([],_)=(0,[])              fun applyDelPartial([],_)=(0,[])
# Line 248  Line 298 
298          in          in
299              (change,exp)              (change,exp)
300          end)          end)
301      | _=>(0,E.Sum(c,E.Apply(E.Partial d,e)))          | _=>(print "nope";(0,E.Sum(c,E.Apply(E.Partial d,e))))
302          (* end case*))          (* end case*))
303    
304  (*  (*
# Line 262  Line 312 
312  (*Apply normalize to each term in product list  (*Apply normalize to each term in product list
313  or Apply normalize to tail of each list*)  or Apply normalize to tail of each list*)
314  fun normalize (Ein.EIN{params, index, body}) = let  fun normalize (Ein.EIN{params, index, body}) = let
315    
316        val changed = ref false        val changed = ref false
317    
318        fun rewriteBody body = (case body        fun rewriteBody body = (case body
319               of E.Const _=> body               of E.Const _=> body
320                | E.Tensor _ =>body                | E.Tensor _ =>body
# Line 297  Line 349 
349                | E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=>                | 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))                      if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0))
351                      else body                      else body
352                 | E.Prod [E.Partial r1, E.Tensor(_,[])]=> (changed:=true;E.Const(0.0))
353               | E.Prod(E.Partial r1::E.Partial r2::p)=>               | E.Prod(E.Partial r1::E.Partial r2::p)=>
354                     (changed:=true;E.Prod([E.Partial(r1@r2)]@p))                     (changed:=true;E.Prod([E.Partial(r1@r2)]@p))
355                 | 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                | E.Prod(e::es)=>let                | E.Prod(e::es)=>let
367                      val e'=rewriteBody e                      val e'=rewriteBody e
368                      val e2=rewriteBody(E.Prod es)                      val e2=rewriteBody(E.Prod es)
# Line 309  Line 372 
372                     end                     end
373    
374                (*Apply*)                (*Apply*)
375    
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                | E.Apply(E.Partial [],e)=> e                | E.Apply(E.Partial [],e)=> e
381    
382                | E.Apply(E.Partial p, e)=>let                | E.Apply(E.Partial p, e)=>let
383                      val body'=E.Apply(E.Partial p, rewriteBody e)                      val body'=E.Apply(E.Partial p, rewriteBody e)
384                      val (c, e')=mkApply2(body')                      val (c, e')=mkApply2(body')
# Line 323  Line 392 
392                | E.Sum([],e)=> (changed:=true;rewriteBody e)                | E.Sum([],e)=> (changed:=true;rewriteBody e)
393                | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)                | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
394                | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))                | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
395                  | E.Sum(c,E.Sub(e1,e2))=>(changed:=true; E.Sub(E.Sum(c,e1),E.Sum(c,e2)))
396                | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>                | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
397                     let val (i,e,rest)=epsToDels(body)                     let val (i,e,rest)=epsToDels(body)
398                     in (case (i, e,rest)                     in (case (i, e,rest)
# Line 342  Line 412 
412                          of E.Prod p=> mkProd p                          of E.Prod p=> mkProd p
413                          |_=> (0,a))                          |_=> (0,a))
414                     in (case change of []=>body'|_=>(changed:=true;body')) end                     in (case change of []=>body'|_=>(changed:=true;body')) end
415                | E.Sum(c,E.Apply(d,e))=>let  
416                      val(c',e')=mkSumApply2(body)                | E.Sum(c,E.Apply(E.Partial _,e))=>let
417                  in (case c' of 1=>(changed:=true;e') |_=>e')                      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                  end                  end
435    
436    
437                | E.Sum(c,e)=>E.Sum(c,rewriteBody e)                | E.Sum(c,e)=>E.Sum(c,rewriteBody e)
438    
439              (*end case*))              (*end case*))
# Line 355  Line 443 
443              in              in
444                if !changed                if !changed
445                     then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body')                     then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body')
446                  else body'                  else (P.printbody(body');body')
447              end              end
448      val b = loop body      val b = loop body
449      in      in

Legend:
Removed from v.2457  
changed lines
  Added in v.2458

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