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

SCM Repository

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

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

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

branches/charisee/src/compiler/high-il/normalize-ein.sml revision 2437, Mon Sep 23 22:28:42 2013 UTC branches/charisee_dev/src/compiler/high-il/normalize-ein.sml revision 3355, Thu Oct 29 22:08:40 2015 UTC
# Line 2  Line 2 
2  structure NormalizeEin = struct  structure NormalizeEin = struct
3    
4      local      local
5      structure G = GenericEin  
6      structure E = Ein      structure E = Ein
7      structure S = Specialize      structure P=Printer
8        structure F=Filter
9        structure G=EpsHelpers
10        structure Eq=EqualEin
11        structure R=RationalEin
12    
13      in      in
14    
15        val testing=0
16  (*Flattens Add constructor: change, expression *)      fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])
17  fun mkAdd [e]=(1,e)      fun mkProd e= F.mkProd e
18      | mkAdd(e)=let      fun filterSca e=F.filterSca e
19      fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')      fun mkAdd e=F.mkAdd e
20          |flatten(i,((E.Const c):: l'))=      fun filterGreek e=F.filterGreek e
21              if (c>0.0 orelse c<0.0) then let      fun mkapply e= derivativeEin.mkapply e
22                      val(b,a)=flatten(i,l') in (b,[E.Const c]@a) end      fun testp n=(case testing
23              else flatten(1,l')          of 0=> 1
24          | flatten(i,[])=(i,[])          | _ =>(print(String.concat n);1)
         | 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)  
25      (*end case*))      (*end case*))
26    
 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*))  
27    
28  fun mkSumApply(E.Sum(c,E.Apply(d, e))) = (case e      (*mkSum:sum_indexid list * ein_exp->int *ein_exp
29      of E.Tensor(a,[])=> (0,E.Const(0.0))      *distribute summation expression
30      | E.Tensor _=> (0,E.Sum(c,E.Apply(d,e)))      *)
31      | E.Field _ =>(0, E.Sum(c, E.Apply(d,e)))      fun mkSum(c1,e1)=(case e1
32      | E.Const _=> (1,E.Const(0.0))          of E.Lift e   => (1,E.Lift(E.Sum(c1,e)))
33      | E.Add l => (1,E.Add(List.map (fn e => E.Sum(c,E.Apply(d, e))) l))          | E.Tensor(_,[]) => (1,e1)
34      | E.Sub(e2, e3) =>(1, E.Sub(E.Sum(c,E.Apply(d, e2)), E.Sum(c,E.Apply(d, e3))))          | E.Const _   => (1,e1)
35      | E.Prod((E.Epsilon c)::e2)=> mkEps(E.Apply(d,e))          | E.ConstR _  => (1,e1)
36      | E.Prod[E.Tensor(a,[]), e2]=>  (0, E.Prod[ E.Tensor(a,[]), E.Sum(c,E.Apply(d, e2))]  )          | E.Prod p    => filterSca(c1,p)
37      | E.Prod((E.Tensor(a,[]))::e2)=>  (0, E.Prod[E.Tensor(a,[]), E.Sum(c,E.Apply(d, E.Prod e2))] )          | _           => (0,E.Sum(c1,e1))
     | 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)))  
38      (*end case*))      (*end case*))
39    
40    
41        (*mkprobe:ein_exp* ein_exp-> int ein_exp
42  (* Identity: (Epsilon ijk Epsilon ilm) e => (Delta jl Delta km - Delta jm Delta kl) e      *rewritten probe
     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.*)  
   
 fun epsToDels(E.Sum(count,E.Prod e))= let  
     fun doubleEps((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::es,e3)=  
         let  
         fun createDeltas(s,t,u,v, e3)=  
             (1,  E.Sub(E.Sum(2,E.Prod([E.Delta(E.V s,E.V u), E.Delta(E.V t,E.V v)] @e3)),  
                     E.Sum(2,E.Prod([E.Delta(E.V s,E.V v), E.Delta(E.V t,E.V u)]@e3))))  
         in if(a=d) then createDeltas(b,c,e,f, e3)  
            else if(a=e) then createDeltas(b,c,f,d, e3)  
            else if(a=f) then createDeltas(b,c,d,e, e3)  
            else if(b=d) then createDeltas(c,a,e,f, e3)  
            else if(b=e) then createDeltas(c,a,f,d,e3)  
            else if(b=f) then createDeltas(c,a,d,e,e3)  
            else if(c=d) then createDeltas(a,b,e,f,e3)  
            else if(c=e) then createDeltas(a,b,f,d,e3)  
            else if(c=f) then createDeltas(a,b,d,e,e3)  
            else (0,(E.Prod((E.Epsilon (a,b,c))::(E.Epsilon(d,e,f))::e3)))  
         end  
     fun findeps(e,[])= (e,[])  
       | findeps(e,(E.Epsilon eps)::es)=  findeps(e@[E.Epsilon eps],es)  
       | findeps(e,es)= (e, es)  
     fun distribute([], s)=(0, [],s)  
       | distribute([e1], s)=(0, [e1], s)  
       | distribute(e1::es, s)= let val(i, exp)=doubleEps(e1::es, s)  
           in if(i=1) then (1, tl(es), [exp])  
              else let val(a,b,c)= distribute(es, s)  
                   in (a, [e1]@b, c) end  
             end  
     val (change, eps,rest)= distribute(findeps([], e))  
     in (change, eps,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.  
43    *)    *)
44        fun mkprobe(e1,x)=let
45  fun mkDel(e) = let          val (c,rtn)=(case e1
46      fun Del(i, [],x)= (i,[],x)              of E.Lift e   => (1,e)
47         | Del(i, d,[])=(i, d,[])              | E.Sqrt a    => (1,E.Sqrt(E.Probe(a,x)))
48         | Del(i, (E.Delta(d1,d2))::d, (E.Tensor(id,[x]))::xs)=              | E.Cosine a    => (1,E.Cosine(E.Probe(a,x)))
49              if(x=d2) then (let              | E.ArcCosine a    => (1,E.ArcCosine(E.Probe(a,x)))
50                 val(i',s,t)= Del(i+1,d, xs)              | E.Sine a    => (1,E.Sine(E.Probe(a,x)))
51                 in Del(i',s, [E.Tensor(id, [d1])] @t) end)              | E.ArcSine a    => (1,E.ArcSine(E.Probe(a,x)))
52              else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)              | E.PowReal(a,n1)    => (1,E.PowReal(E.Probe(a,x),n1))
53                 val(i2,s2,t2)= Del(i',d,[E.Tensor(id,[x])]@t)              | E.Prod []   => err("Probe of empty product")
54                 in (i2,s@s2, t2) end )              | E.Prod p    => (1,E.Prod (List.map (fn(a)=>E.Probe(a,x)) p))
55         | Del(i, (E.Delta(d1,d2))::d, (E.Field(id,[x]))::xs)=              | E.Apply _   => (0,E.Probe(e1,x))
56                     if(x=d2) then (let              | E.Conv _    => (0,E.Probe(e1,x))
57                     val(i',s,t)= Del(i+1,d, xs)              | E.Field _   => (0,E.Probe(e1,x))
58                     in Del(i',s, [E.Field(id, [d1])] @t) end)              | E.Sum(c,e') =>  (1,E.Sum(c,E.Probe(e',x)))
59                     else (let val (i',s,t)= Del(i,[E.Delta(d1,d2)],xs)              | E.Add e     => (1,E.Add (List.map (fn(a)=>E.Probe(a,x)) e))
60                     val(i2,s2,t2)= Del(i',d,[E.Field(id,[x])]@t)              | E.Sub (a,b) => (1,E.Sub(E.Probe(a,x),E.Probe(b,x)))
61                     in (i2,s@s2, t2) end )              | E.Neg a    => (1,E.Neg(E.Probe(a,x)))
62                | E.Div (a,b) => (1,E.Div(E.Probe(a,x),E.Probe(b,x)))
63          | Del(i, d, t)= (i,d,t)              | E.Const _   => (1,e1)
64      fun findels(e,[])= (e,[])              | Ein.ConstR _          =>(1,e1)
65         | findels(e,es)= let val del1= hd(es)              | E.Tensor _  => err("Tensor without Lift")
66              in (case del1              | E.Delta _   => (0,e1)
67                 of E.Delta _=> findels(e@[del1],tl(es))              | E.Epsilon _ => (0,e1)
68                  |_=> (e, es))              | E.Eps2 _    => (0,e1)
69              end              | E.Partial _ => err("Probe Partial")
70      val(a,b)= findels([], e)              | E.Probe _   => err("Probe of a Probe")
71                | E.Krn _     => err("Krn used before expand")
72                | E.Value _   => err("Value used before expand")
73                | E.Img _     => err("Probe used before expand")
74                (*end case*))
75      in      in
76        Del(0, a, b)              (c,rtn)
77      end      end
78    
79        (* normalize: EIN->EIN
80  (*The Deltas are distributed over to the tensors in the expression e.      * rewrite body of EIN
81   This function checks for instances of the dotProduct.      * note "c" keeps track if ein_exp is changed
 Sum_2 (Delta_ij (A_i B_j D_k))=>Sum_1(A_i B_i) D_k  
82  *)  *)
83     fun checkDot(E.Sum(s,E.Prod e))= let      fun normalize (ee as Ein.EIN{params, index, body},args) = 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)  
   
   
   
   
   
   
   
 (*Apply normalize to each term in product list  
 or Apply normalize to tail of each list*)  
 fun normalize (Ein.EIN{params, index, body}) = let  
84        val changed = ref false        val changed = ref false
85        fun rewriteBody body = (case body        fun rewriteBody body = (case body
86               of E.Const _=> body               of E.Const _=> body
87            | Ein.ConstR _  => body
88                | E.Tensor _ =>body                | E.Tensor _ =>body
89                | E.Field _=> body                | E.Field _=> body
               | E.Kernel _ =>body  
90                | E.Delta _ => body                | E.Delta _ => body
               | E.Value _ =>body  
91                | E.Epsilon _=>body                | E.Epsilon _=>body
92                | E.Neg e => E.Neg(rewriteBody e)          | E.Eps2 _      => body
93                | E.Add es => let val (b,a)= mkAdd(List.map rewriteBody es)          | E.Conv _      => body
                    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)  
94                | E.Partial _=>body                | E.Partial _=>body
95                | E.Conv (V, alpha)=> E.Conv(rewriteBody V, alpha)          | E.Krn _       => raise Fail"Krn before Expand"
96                | E.Probe(u,v)=>  E.Probe(rewriteBody u, rewriteBody v)          | E.Img _       => raise Fail"Img before Expand"
97                | E.Image es => E.Image(List.map rewriteBody es)          | E.Value _     => raise Fail"Value before Expand"
98            | E.Lift e          => E.Lift(rewriteBody e)
99            | E.Sqrt e          => E.Sqrt(rewriteBody e)
100  (************Summation *************)          | E.Cosine e        => E.Cosine(rewriteBody e)
101            | E.ArcCosine e     => E.ArcCosine(rewriteBody e)
102                | E.Sum(0, e)=>e          | E.Sine e          => E.Sine(rewriteBody e)
103                | E.Sum(_, (E.Const c))=> E.Const c          | E.ArcSine e       => E.ArcSine(rewriteBody e)
104                | E.Sum(c,(E.Add l))=> E.Add(List.map (fn e => E.Sum(c,e)) l)          | E.PowInt(e,n1)    => E.PowInt(rewriteBody e,n1)
105            | E.PowReal(e,n1)   => E.PowReal(rewriteBody e,n1)
106                | E.Sum(c,E.Prod((E.Delta d)::es))=>(              (*************Algebraic Rewrites **************)
107                  let val (i,dels, e)= mkDel((E.Delta d)::es)          | E.Neg(E.Neg e)    => rewriteBody e
108                      val rest=(case e of [e1]=> rewriteBody e1          | E.Neg(E.Const 0)  => ( changed:=true;E.Const 0)
109                              |_=> rewriteBody(E.Prod(e)))          | E.Neg e           => E.Neg(rewriteBody e)
110                      val soln= (case rest of E.Prod r=> E.Sum(c-i, E.Prod(dels@r))          | E.Add es          => let
111                          |_=>E.Sum(c-i, E.Prod(dels@[rest])))              val (change,body')= mkAdd(List.map rewriteBody es)
112                      val q= checkDot(soln)              in if (change=1) then ( changed:=true;body') else body' end
113                      in if (i=0) then q  (*
114                     else (changed :=true;q)          | E.Sub(a, E.Field f)=> (changed:=true;E.Add[a, E.Neg(E.Field(f))])
                    end )  
   
   
115    
116                | E.Sum(c,E.Prod((E.Epsilon e1 )::(E.Epsilon e2)::xs))=>  *)
117                     let val (i,eps, e)= epsToDels(body)          | E.Sub (E.Const 0,b)                   => (changed:=true;E.Neg(rewriteBody b))
118            | E.Sub (a,E.Const 0)                   => (changed:=true;rewriteBody a)
119            | E.Sub (a,b)                   => E.Sub(rewriteBody a, rewriteBody b)
120            | E.Div(E.Const 0,e)            =>  (changed:=true;E.Const 0)
121            (*| E.Div(e1 as E.Tensor(_,[_]),e2 as E.Tensor(_,[]))=>
122                    rewriteBody (E.Prod[E.Div(E.Const 1, e2),e1])*)
123            | E.Div(E.Div(a,b),E.Div(c,d))  => rewriteBody(E.Div(E.Prod[a,d],E.Prod[b,c]))
124            | E.Div(E.Div(a,b),c)           => rewriteBody (E.Div(a, E.Prod[b,c]))
125            | E.Div(a,E.Div(b,c))           => rewriteBody (E.Div(E.Prod[a,c],b))
126            | E.Div (a, b)                  => (E.Div(rewriteBody a, rewriteBody b))
127                (**************Apply, Sum, Probe**************)
128            | E.Apply(E.Partial [],e)   => e
129            | E.Apply(E.Partial d1, e1) =>
130                let
131                val e2 = rewriteBody e1
132                val (c,e3)=mkapply(E.Partial d1,e2)
133                     in                     in
134                     if (i=0) then let val e'=rewriteBody(E.Prod(e)) in (case e'                  (case c of 1=>(changed:=true;e3)| _ =>e3 (*end case*))
135                          of E.Prod m=> let val (i2, p)= mkProd(eps @ m)              end
136                                      in E.Sum(c, p) end          | E.Apply _                 => raise Fail" Not well-formed Apply expression"
137                          |_=>E.Sum(c, E.Prod(eps@ [e']))) end          | E.Sum([],e)               => (changed:=true;rewriteBody e)
138                     else(let val [list]=e          | E.Sum(c,e)                => let
139                          val ans=rewriteBody(list)              val (c,e')=mkSum(c,rewriteBody e)
140                          val soln=(case ans              in
141                              of E.Sub (E.Sum(c1,(E.Prod s1)),E.Sum(c2,(E.Prod s2))) =>                  (case c of 0 => e'|_ => (changed:=true;e'))
142                                  E.Sum(c-3+c1, E.Sub(E.Prod(eps@s1),E.Prod(eps@s2)))              end
143                              | E.Sub (E.Sum(c1,s1),E.Sum(c2,s2)) =>          | E.Probe(u,v)              =>
                                 E.Sum(c-3+c1, E.Prod(eps@ [E.Sub(s1,s2)]))  
                             |_=> E.Prod(eps@ [ans]))  
                         in (changed :=true;soln) end  
                    ) end  
   
   
             | E.Sum(c, E.Apply(E.Partial p,   E.Prod((E.Delta(i,j))::e3 )))=>  
   
144                  let                  let
145                     fun part([], e2, counter)=([], e2, counter)              val (c',b')=mkprobe(rewriteBody u,rewriteBody v)
146                        | part(p1::ps, [E.Delta(i,j)],counter)=              in (case c'
147                              if (p1=j) then ([i]@ps,[],counter-1)                  of 1=> (changed:=true;b')
148                              else (let                  |_=> b'
149                                      val (a,b,counter)=part(ps, [E.Delta(i,j)],counter)                  (*end case*))
150                                  in ([p1]@a, b,counter )  end)              end
151                     val (e1,e2,counter)= part(p, [E.Delta(i,j)],c)          (*************Product**************)
152            | E.Prod [] => raise Fail"missing elements in product"
153                     in  E.Sum(counter, E.Apply(E.Partial e1, E.Prod(e2@e3))) end          | E.Prod [e1] => rewriteBody e1
154            | E.Prod[(e1 as E.Sqrt(s1)),(e2 as E.Sqrt(s2))]=>
155              | E.Sum(c, E.Apply(p, e))=>let              if(Eq.isBodyEq(s1,s2)) then (changed :=true;s1)
156                     val e'= rewriteBody(E.Sum(c, e))              else let
157                     val p'= rewriteBody p                  val a=rewriteBody e1
158                     val (i, e2)= (case e'                  val b=rewriteBody e2
159                          of E.Sum(c',exp)=> mkSumApply(E.Sum(c', E.Apply(p', exp)))                  val  (_,d)=mkProd ([a,b])
160                          |_=>mkApply( E.Apply(p', e')))                  in d
161                     in if(i=1) then (changed :=true;e2) else e2 end                  end
               | E.Sum(c, e)=> E.Sum(c, rewriteBody e)  
   
   
   
   
   
   
 (************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.Partial r2)::e) =>  
                     (changed := true; E.Prod([E.Partial (r1@r2)] @ e))  
162    
163            (*************Product EPS **************)
164    
165            | E.Prod(E.Epsilon(i,j,k)::E.Apply(E.Partial d,e)::es)=>let
166                val change= G.matchEps(0,d,[],[i,j,k])
167                in case (change,es)
168                    of (1,_) =>(changed:=true; E.Const 0)
169                    | (_,[]) =>E.Prod[E.Epsilon(i,j,k),rewriteBody (E.Apply(E.Partial d,e))]
170                    |(_,_)=> let
171                        val a=rewriteBody(E.Prod([E.Apply(E.Partial d,e)]@ es))
172                        val (_,b)=mkProd [E.Epsilon(i,j,k),a]
173                        in b end
174                end
175    (*
176            | E.Prod(E.Epsilon(i,j,k)::E.Conv(V1,[a1], h1, d1)::E.Conv(V,alpha, h, d)::es)=>let
177                val change= G.matchEps(0,alpha@d,[],[i,j,k])
178                in case (change,es)
179                    of (1,_) =>(changed:=true; E.Lift(E.Const 0))
180                    | (_,[]) =>E.Prod[E.Epsilon(i,j,k),E.Conv(V1,[a1], h1, d1),E.Conv(V,alpha, h, d)]
181                    | (_,_) =>let
182                        val a=rewriteBody(E.Prod([E.Conv(V1,[a1], h1, d1),E.Conv(V,alpha, h, d)]@ es))
183                        val (_,b) = mkProd [E.Epsilon(i,j,k),a]
184                        in b end
185                end
186    *)
187            | E.Prod(E.Epsilon(i,j,k)::E.Conv(V,alpha, h, d)::es)=>let
188                val change= G.matchEps(0,d,[],[i,j,k])
189                in case (change,es)
190                    of (1,_) =>(changed:=true; E.Lift(E.Const 0))
191                    | (_,[]) =>E.Prod[E.Epsilon(i,j,k),E.Conv(V,alpha, h, d)]
192                    | (_,_) =>let
193                        val a=rewriteBody(E.Prod([E.Conv(V,alpha, h, d)]@ es))
194                        val (_,b) = mkProd [E.Epsilon(i,j,k),a]
195                        in b end
196                end
197                | 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])]=>
198                      if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0.0))              if(e2=i1 andalso e3=i2)
199                then (changed :=true;E.Const(0))
200                      else body                      else body
201    (*
202                | E.Prod((E.Epsilon eps1)::es)=> (let          | E.Prod(E.Epsilon e1::E.Sum(c1,E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es3))::es2))::es1) =>
203                      val rest=(case es              (case G.epsToDels([E.Epsilon e1, E.Epsilon e2]@es3@es2@es1)
204                          of [e1] => rewriteBody e1              of (1,e,sx,_,_)=> (changed:=true; E.Sum(c1@c2@sx,e))
205                           | _=> rewriteBody( E.Prod es))              | (_,_,_,_,_)=>let
206                        val eA=rewriteBody(E.Epsilon e1)
207                      val (i, solution)=(case rest                      val eB=rewriteBody(E.Prod(E.Sum(c1,E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es3))::es2))::es1))
208                          of E.Prod m=> mkProd ([E.Epsilon eps1] @m )                      val (_,e)=mkProd([eA,eB])
209                          |_=>  mkProd([E.Epsilon eps1]@ [rest]))                  in
210                  in if (i=1) then (changed:=true;solution)                      e
211                      else solution                  end
212                  end)              (*end case*))
213    *)
214               | E.Prod (e::es) => (let          | E.Prod(E.Epsilon eps1::ps)=> (case (G.epsToDels(E.Epsilon eps1::ps))
215                      val r=rewriteBody(E.Prod es)              of (1,e,[],_,_)      =>(changed:=true;e)(* Changed to Deltas*)
216                      val (i,solution)= (case r              | (1,e,sx,_,_)      =>(changed:=true;E.Sum(sx,e))
217                          of E.Prod m => mkProd([e]@m )                      (* Changed to Deltas *)
218                          |_=> mkProd([e]@ [r]))              | (_,_,_,_,[])   =>  body
219                  in if (i=1) then (changed:=true;solution)              | (_,_,_,epsAll,rest) => let
220                          else solution                  val p'=rewriteBody(E.Prod rest)
221                  end)                  val(_,b)= mkProd(epsAll@[p'])
222                    in b end
223  (**************Apply*******************)              (*end case*))
224            | E.Prod(E.Sum(c1,E.Prod(E.Epsilon e1::es1))::E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es) =>
225                (case G.epsToDels([E.Epsilon e1, E.Epsilon e2]@es1@es2@es)
226                | E.Apply(E.Partial p, E.Prod((E.Delta(i,j))::e3))=>                  of (1,e,sx,_,_)=> (changed:=true; E.Sum(c1@c2@sx,e))
227                      let fun part([], e2)=([], e2)                  | (_,_,_,_,_)=>let
228                            | part(p1::ps, [E.Delta(i,j)])=                      val eA=rewriteBody(E.Sum(c1,E.Prod(E.Epsilon e1::es1)))
229                              if (p1=j) then ([i]@ps,[])                  val eB=rewriteBody(E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es))
230                              else (let val (a,b)=part(ps, [E.Delta(i,j)])                  val (_,e)=mkProd([eA,eB])
231                                  in ([p1]@a, b )  end)                  in
232                          val (e1,e2)= part(p, [E.Delta(i,j)])                      e
233                      in   E.Apply(E.Partial e1, E.Prod(e2@e3)) end                  end
234                (*end case*))
235                | E.Apply(E.Partial d,e)=> ( let val (t1,t2)= mkApply(E.Apply(E.Partial d, rewriteBody e))          | E.Prod[E.Delta d, E.Neg e]=> (changed:=true;E.Neg(E.Prod[E.Delta d, e]))
236                      in if (t1=1) then (changed :=true;t2) else t2 end)          | E.Prod(E.Delta d::es)=>let
237                val (pre',eps, dels,post)= filterGreek(E.Delta d::es)
238                | E.Apply(E.Prod d,e)=> ( let val (t1,t2)= mkApply(E.Apply(rewriteBody (E.Prod d), rewriteBody e))               val _= testp["\n\n Reduce delta--",P.printbody(body)]
239                     in if (t1=1) then (changed :=true;t2) else t2 end)              val (change,a)=G.reduceDelta(eps, dels, post)
240                  val _= testp["\n\n ---delta moved--",P.printbody(a)]
241                | E.Apply _ => (print "Err Apply ";body)              in (case (change,a)
242                    of (0, _)=> E.Prod [E.Delta d,rewriteBody(E.Prod es)]
243                    | (_, E.Prod p)=>let
244                |_=> body                      val (_, p') = mkProd p
245                        in (changed:=true;p') end
246                    | _ => (changed:=true;a )
247                    (*end case*))
248                end
249          | E.Prod[e1,e2]=> let
250                val (_,b)=mkProd[rewriteBody e1, rewriteBody e2]
251                in b end
252          | E.Prod(e::es)=>let
253                val e'=rewriteBody e
254                val e2=rewriteBody(E.Prod es)
255                val(_,b)=(case e2
256                    of E.Prod p'=> mkProd([e']@p')
257                    |_=>mkProd [e',e2])
258                in
259                        b
260               end
261    
262              (*end case*))              (*end case*))
263    
264        fun loop body = let      val _=testp["\n******** Start Normalize: \n",P.printerE ee,"\n*****\n"]
265        fun loop(body ,count) = let
266            (*val _=raise Fail"do not use dev branch"*)
267            val _= testp["\n\n N =>",Int.toString(count),"--",P.printbody(body)]
268              val body' = rewriteBody body              val body' = rewriteBody body
269    
270              in              in
271                if !changed                if !changed
272                  then (changed := false; loop body')              then  (changed := false ;loop(body',count+1))
273                  else body'              else (body',count)
274              end              end
275      val b = loop body  
276        val (b,count) = loop(body,0)
277        val _ =testp["\n Out of normalize \n",P.printbody(b),
278            "\n    Final CounterXX:",Int.toString(count),"\n\n"]
279      in      in
280      ((Ein.EIN{params=params, index=index, body=b}))          (Ein.EIN{params=params, index=index, body=b},count)
281      end      end
282    end    end
283    
284    
   
   
   
285  end (* local *)  end (* local *)

Legend:
Removed from v.2437  
changed lines
  Added in v.3355

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