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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2449 - (download) (annotate)
Thu Oct 3 20:15:16 2013 UTC (5 years, 10 months ago) by cchiw
File size: 14557 byte(s)
 
structure NormalizeEin = struct

    local

    structure E = Ein
   structure P=Printer

    in

      
(*Flattens Add constructor: change, expression *)
fun mkAdd [e]=(1,e)
    | mkAdd(e)=let
    fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')
        |flatten(i,((E.Const c):: l'))=
            if (c>0.0 orelse c<0.0) then let
                    val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end
            else flatten(1,l')
        | flatten(i,[])=(i,[])
        | flatten (i,e::l') =  let
                    val(b,a)=flatten(i,l') in (b,[e]@a) end
    
     val (b,a)=flatten(0,e)
    in case a
     of [] => (1,E.Const(1.0))
                | [e] => (1,e)
                | es => (b,E.Add es)
                (* end case *)
     end
        
(*
fun mkProd [e]=(1,e)
    | mkProd(e)=let
    fun flatten(i,((E.Prod l)::l'))= flatten(1,l@l')
        |flatten(i,((E.Const c):: l'))=
           if(c>0.0 orelse c<0.0) then
               if (c>1.0 orelse c<1.0) then let
                val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end
               else flatten(1,l')
            else (3, [E.Const(0.0)])
         | flatten(i,[])=(i,[])
         | flatten (i,e::l') =  let
                    val(b,a)=flatten(i,l') in (b,[e]@a) end
     val ( b,a)=flatten(0,e)
     in if(b=3) then (1,E.Const(0.0))
        else case a
        of [] => (1,E.Const(0.0))
        | [e] => (1,e)
        | es => (b, E.Prod es)
        (* end case *)
         end
        
                   
fun mkEps(e)= (case e
    of E.Apply(E.Partial [E.V a], E.Prod( e2::m ))=> (0,e)
     | E.Apply(E.Partial [E.V a,E.V b], E.Prod( (E.Epsilon(i,j,k))::m ))=>
        (if(a=i andalso b=j) then (1,E.Const(0.0))
        else if(a=i andalso b=k) then (1,E.Const(0.0))
        else if(a=j andalso b=i) then (1,E.Const(0.0))
        else if(a=j andalso b=k) then (1,E.Const(0.0))
        else if(a=k andalso b=j) then (1,E.Const(0.0))
        else if(a=k andalso b=i) then (1,E.Const(0.0))
        else (0,e))
    |_=> (0,e)
    (*end case*))
                   
fun mkApply(E.Apply(d, e)) = (case e
    of E.Tensor(a,[])=> (0,E.Const(0.0))
     | E.Tensor _=> (0,E.Apply(d,e))
     | E.Const _=> (1,E.Const(0.0))
     | E.Add l => (1,E.Add(List.map (fn e => E.Apply(d, e)) l))
     | E.Sub(e2, e3) =>(1, E.Sub(E.Apply(d, e2), E.Apply(d, e3)))
     | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e))
     | E.Prod[E.Tensor(a,[]), e2]=>  (0, E.Prod[ E.Tensor(a,[]), E.Apply(d, e2)]  )
     | E.Prod((E.Tensor(a,[]))::e2)=>  (0, E.Prod[E.Tensor(a,[]), E.Apply(d, E.Prod e2)] )
     | E.Prod es =>    (let
           fun prod [e] = (E.Apply(d, e))
              | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]
                   val lr=e2 @[E.Apply(d,e1)]   val(b,a) =mkProd lr
                in ( E.Add[ a, m] )
                end)
             | prod _= (E.Const(1.0))
                in (1,prod es)
                end)
             | _=> (0,E.Apply(d,e))
             (*end case*))
                   
fun mkSumApply(E.Sum(c,E.Apply(d, e))) = (case e
    of E.Tensor(a,[])=> (0,E.Const(0.0))
    | E.Tensor _=> (0,E.Sum(c,E.Apply(d,e)))
    | E.Field _ =>(0, E.Sum(c, E.Apply(d,e)))
    | E.Const _=> (1,E.Const(0.0))
    | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l))
    | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(d, e2)), E.Sum(c,E.Apply(d, e3))))
    | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e))
    | 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)=>  (0, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )
    | E.Prod es =>   (let
        fun prod [e] = (E.Apply(d, e))
        | prod(e1::e2)=(let val l= prod(e2) val m= E.Prod[e1,l]
            val lr=e2 @[E.Apply(d,e1)]   val(b,a) =mkProd lr
            in ( E.Add[ a, m] ) end)
        | prod _= (E.Const(1.0))
            in (1, E.Sum(c,prod es))  end)
    | _=> (0,E.Sum(c,E.Apply(d,e)))
    (*end case*))
                   
                   
                   
(* Identity: (Epsilon ijk Epsilon ilm) e => (Delta jl Delta km - Delta jm Delta kl) e
    The epsToDels Function searches for Epsilons in the expression, checks for this identity in all adjacent Epsilons and if needed, does the transformation.
     The Function returns two separate list, 1 is the remaining list of Epsilons that have not be changed to deltas, and the second is the Product of the remaining expression.
  Ex:(Epsilon_ijk Epsilon_ilm) Epsilon_stu e =>([Epsilon_stu], [Delta_jl,Delta_km,e -Delta_jm Delta_kl, e] )
   This is useful since we can normalize the second list without having to normalize the epsilons again.
        4(Eps Eps)
       3( Delta_liDelta mj- Delta_mi Delta_lj)
         Ai-
        *)
                   
                   
                   *)
                   
                   
fun epsToDels(E.Sum(count,E.Prod e))= let
    fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,eps,e3)=
        let

        (*Function is called when eps are being changed to deltas*)
        fun createDeltas(i,s,t,u,v, e3)= let

            (*remove index from original index list*)
            (*currrent, left, sumIndex*)

            fun rmIndex(_,_,[])=[]
            | rmIndex([],[],cs)=cs
            | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
            | rmIndex(i::ix,rest ,(E.V c)::cs)=
                   if(i=c) then rmIndex(rest@ix,[],cs)
                   else rmIndex(ix,rest@[i],(E.V c)::cs)
                   
            val s'= rmIndex([i,s,t,u,v],[],count)
            val s''=[E.V s, E.V t ,E.V u, E.V v]
            val deltas= E.Sub(
                    E.Sum(s'',E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)),
                    E.Sum(s'',E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3)))
                   
            in (case (eps,s')
                of ([],[]) =>(1,deltas)
                |([],_)=>(1,E.Sum(s',deltas))
                |(_,[])=>(1,E.Prod(eps@[deltas]))
                |(_,_) =>(1, E.Sum(s', E.Prod(eps@[deltas])))
                   )
             end 
                
        in if(a=d) then createDeltas(a,b,c,e,f, e3)
           else if(a=e) then createDeltas(a,b,c,f,d, e3)
           else if(a=f) then createDeltas(a,b,c,d,e, e3)
           else if(b=d) then createDeltas(b,c,a,e,f, e3)
           else if(b=e) then createDeltas(b,c,a,f,d,e3)
           else if(b=f) then createDeltas(b,c,a,d,e,e3)
           else if(c=d) then createDeltas(c,a,b,e,f,e3)
           else if(c=e) then createDeltas(c,a,b,f,d,e3)
           else if(c=f) then createDeltas(c,a,b,d,e,e3)
           else (0,E.Const 0.0)
        end 
    fun findeps(e,[])= (e,[])
      | findeps(e,(E.Epsilon eps)::es)=  findeps(e@[E.Epsilon eps],es)
      | findeps(e,es)= (e, es)
           
      
    fun dist([],eps,rest)=(0,eps,rest)
     | dist([e],eps,rest)=(0,eps@[e],rest)
     | dist(c1::current,eps,rest)=let
            val(i, exp)= doubleEps(c1::current,eps,rest)
        in  (case i of 1=>(i,[exp],[E.Const 2.0])
            |_=> dist(current, eps@[c1],rest))
        end

               
        
    val (es,rest)=findeps([],e)
                   
    in
        dist(es,[],rest)
    end

(*

                   
                   
                   
(*The Deltas then need to be distributed over to the tensors in the expression e.
Ex.:Delta ij ,Tensor_j, e=> Tensor_i,e. The mkDelts function compares every Delta in the expression to the tensors in the expressions while keeping the results in the correct order.
   This also returns a list of deltas and a list of the remaining expression.
  *)

fun mkDel(e) = let
    fun Del(i, [],x)= (i,[],x)
       | Del(i, d,[])=(i, d,[])
       | Del(i, (E.Delta(d1,d2))::d, (E.Tensor(id,[x]))::xs)=
            if(x=d2) then (let
               val(i',s,t)= Del(i+1,d, xs)
               in Del(i',s, [E.Tensor(id, [d1])] @t) end)
            else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)
               val(i2,s2,t2)= Del(i',d,[E.Tensor(id,[x])]@t)
               in (i2,s@s2, t2) end )
       | Del(i, (E.Delta(d1,d2))::d, (E.Field(id,[x]))::xs)=
                   if(x=d2) then (let
                   val(i',s,t)= Del(i+1,d, xs)
                   in Del(i',s, [E.Field(id, [d1])] @t) end)
                   else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)
                   val(i2,s2,t2)= Del(i',d,[E.Field(id,[x])]@t)
                   in (i2,s@s2, t2) end )
                   
        | Del(i, d, t)= (i,d,t)
    fun findels(e,[])= (e,[])
       | findels(e,es)= let val del1= hd(es)
            in (case del1
               of E.Delta _=> findels(e@[del1],tl(es))
                |_=> (e, es))
            end
    val(a,b)= findels([], e) 
    in
      Del(0, a, b)
    end

                   
(*The Deltas are distributed over to the tensors in the expression e.
 This function checks for instances of the dotProduct.
Sum_2 (Delta_ij (A_i B_j D_k))=>Sum_1(A_i B_i) D_k 
*)
   fun checkDot(E.Sum(s,E.Prod e))= let
       fun dot(i,d,r, (E.Tensor(ida,[a]))::(E.Tensor(idb,[b]))::ts)=
                   if (a=b) then
                        dot(i-1,d@[E.Sum(1,E.Prod[(E.Tensor(ida,[a])), (E.Tensor(idb,[b]))])], [],r@ts)
                   else dot(i,d, r@[E.Tensor(idb,[b])],(E.Tensor(ida,[a]))::ts)
          |dot(i, d,r, [t])=dot(i,d@[t], [], r)
          |dot(i,d, [],[])= (i,d, [],[])
          |dot(i,d, r, [])= dot(i,d, [], r)
          |dot(i, d, r, (E.Prod p)::t)= dot (i, d, r, p@t)
          |dot(i,d, r, e)= (i,d@r@e, [], [])
                   
        val(i,d,r,c)= dot(s,[],[], e)
        val soln= (case d of [d1]=>d1
                   |_=> E.Prod d)
        in E.Sum(i,soln) end
      |checkDot(e)= (e)
                   
                   




                *)
                   
fun reduceDelta(E.Sum(c,E.Prod p))=let
            
    fun findDeltas(dels,rest,E.Delta d::es)= findDeltas(dels@[E.Delta d], rest, es)
    | findDeltas(dels,rest,E.Epsilon eps::es)=findDeltas(dels,rest@[E.Epsilon eps],es)
    | findDeltas(dels,rest,es)=  (dels,rest,es)

    fun rmIndex(_,_,[])=[]
        | rmIndex([],[],cs)=cs
        | rmIndex([],m ,e1::cs)=[e1]@rmIndex(m,[],cs)
        | rmIndex(i::ix,rest ,c::cs)=
            if(i=c) then rmIndex(rest@ix,[],cs)
            else rmIndex(ix,rest@[i],c::cs)
    
    fun distribute(change,d,dels,[],done)=(change,dels@d,done)
        | distribute(change,[],[],e,done)=(change,[],done@e)
        | distribute(change,E.Delta(i,j)::ds,dels,E.Tensor(id,[tx])::es,done)=
            if(j=tx) then distribute(change@[j],dels@ds,[] ,es ,done@[E.Tensor(id,[i])])
            else distribute(change,ds,dels@[E.Delta(i,j)],E.Tensor(id,[tx])::es,done)
        | distribute(change,d,dels,e::es,done)=distribute(change,dels@d,[],es,done@[e])
 
    val (dels,eps,es)=findDeltas([],[],p)
    val (change,dels',done)=distribute([],dels,[],es,[])
    val index=rmIndex(change,[],c)
    
  in
       (change, E.Sum(index,E.Prod (eps@dels'@done)))
  end

                   
                   
(*Apply normalize to each term in product list
or Apply normalize to tail of each list*)
fun normalize (Ein.EIN{params, index, body}) = let
      val changed = ref false
      fun rewriteBody body = (case body
             of E.Const _=> body
              | E.Tensor _ =>body
              | E.Field _=> body
              | E.Kernel _ =>body
              | E.Delta _ => body
              | E.Value _ =>body
              | E.Epsilon _=>body
            
              | E.Neg e => E.Neg(rewriteBody e)
              | E.Add es => let val (b,a)= mkAdd(List.map rewriteBody es)
                   in if (b=1) then ( changed:=true;a) else a end
              | E.Sub (a,b)=>  E.Sub(rewriteBody a, rewriteBody b)
              | E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b)     
              | E.Partial _=>body
              | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha)
              | E.Probe(u,v)=>  E.Probe(rewriteBody u, rewriteBody v)
              | E.Image es => E.Image(List.map rewriteBody es)
                   
                (*Product*)
              | E.Prod [e1] => rewriteBody e1
              | E.Prod(e1::(E.Add(e2))::e3)=>
                   (changed := true; E.Add(List.map (fn e=> E.Prod([e1, e]@e3)) e2))
              | E.Prod(e1::(E.Sub(e2,e3))::e4)=>
                   (changed :=true; E.Sub(E.Prod([e1, e2]@e4), E.Prod([e1,e3]@e4 )))
              | E.Prod [E.Partial r1,E.Conv(f,deltas)]=>
                   (changed :=true;E.Conv(f,deltas@r1))
              | E.Prod (E.Partial r1::E.Conv(f,deltas)::ps)=>
                   (changed:=true; E.Prod([E.Conv(f,deltas@r1)]@ps))
            
                   
              | E.Prod(e::es)=>let
                    val e'=rewriteBody e
                    val e2=rewriteBody(E.Prod es)
                    in(case e2 of E.Prod p'=> E.Prod([e']@p')
                        |_=>E.Prod [e',e2])
                   end
                   
              (*Apply*)
              | E.Apply(e1,e2)=>E.Apply(rewriteBody e1, rewriteBody e2)
                   
                   
                   
              (* Sum *)
              | E.Sum([],e)=> rewriteBody e
                   | E.Sum(_,E.Const c)=>(changed:=true;E.Const c)
              | E.Sum(c,(E.Add l))=> (changed:=true;E.Add(List.map (fn e => E.Sum(c,e)) l))
              | E.Sum(c,E.Prod(E.Epsilon eps1::E.Epsilon eps2::ps))=>
                   let val (i,e,rest)=epsToDels(body)
                   in (case (i, e,rest)
                   of (1,[e1],_) =>(changed:=true;e1)
                        |(0,eps,[])=>body
                        |(0,eps,rest)=>(let
                            val p'=rewriteBody(E.Prod rest)
                            val p''= (case p' of E.Prod p=>p |e=>[e])
                            in E.Sum(c, E.Prod (eps@p'')) end
                            )
                        |_=>body
                   ) end
              | E.Sum(c, E.Prod(E.Delta d::es))=>let
                    val (change,body')=reduceDelta(body)
                   in (case change of []=>body'|_=>(changed:=true;body')) end
              | E.Sum(c,e)=>E.Sum(c,rewriteBody e)

            (*end case*))

      fun loop body = let
            val body' = rewriteBody body
            in
              if !changed
                   then (changed := false; print " \n \t => \n \t ";print( P.printbody body');print "\n";loop body')
                else body'
            end
    val b = loop body
    in
    ((Ein.EIN{params=params, index=index, body=b}))
    end
end 


end (* local *)

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