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

SCM Repository

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

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

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

revision 2844, Tue Dec 9 18:05:29 2014 UTC revision 2845, Fri Dec 12 06:46:23 2014 UTC
# Line 11  Line 11 
11      in      in
12    
13  fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])  fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])
14  val testing=1      val testing=0
15  fun flatProd e =F.rewriteProd e  fun flatProd e =F.rewriteProd e
16  fun mkProd e= F.mkProd e  fun mkProd e= F.mkProd e
17  fun filterSca e=F.filterSca e  fun filterSca e=F.filterSca e
18  fun filterField e=F.filterField e  fun filterField e=F.filterField e
19  fun mkAdd e=F.mkAdd e  fun mkAdd e=F.mkAdd e
20  fun filterGreek e=F.filterGreek e  fun filterGreek e=F.filterGreek e
   
   
21  fun testp n=(case testing  fun testp n=(case testing
22  of 0=> 1  of 0=> 1
23  | _ =>(print(String.concat n);1)  | _ =>(print(String.concat n);1)
# Line 118  Line 116 
116      | E.Img _     => err("Probe used before expand")      | E.Img _     => err("Probe used before expand")
117      (*end case*))      (*end case*))
118    
   
119  (*mkprobe:ein_exp* ein_exp-> int ein_exp  (*mkprobe:ein_exp* ein_exp-> int ein_exp
120  *rewritten probe  *rewritten probe
121  *)  *)
# Line 146  Line 143 
143      | E.Img _     => err("Probe used before expand")      | E.Img _     => err("Probe used before expand")
144  (*end case*))  (*end case*))
145    
   
146  (*normalize: EIN->EIN  (*normalize: EIN->EIN
147  *rewrite body of EIN  *rewrite body of EIN
148        * note "c" keeps track if ein_exp is changed
149  *)  *)
150  fun normalize (ee as Ein.EIN{params, index, body}) = let  fun normalize (ee as Ein.EIN{params, index, body}) = let
151        val changed = ref false        val changed = ref false
   
152        fun rewriteBody body =(case body        fun rewriteBody body =(case body
153              of E.Const _    => body              of E.Const _    => body
154              | E.Tensor _    => body              | E.Tensor _    => body
# Line 165  Line 161 
161              | E.Krn _       => raise Fail"Krn before Expand"              | E.Krn _       => raise Fail"Krn before Expand"
162              | E.Img _       => raise Fail"Img before Expand"              | E.Img _       => raise Fail"Img before Expand"
163              | E.Value _     => raise Fail"Value before Expand"              | E.Value _     => raise Fail"Value before Expand"
   
164                  (*************Algebraic Rewrites **************)                  (*************Algebraic Rewrites **************)
165              | E.Neg(E.Neg e)    => rewriteBody e              | E.Neg(E.Neg e)    => rewriteBody e
166              | E.Neg e           => E.Neg(rewriteBody e)              | E.Neg e           => E.Neg(rewriteBody e)
167              | E.Lift e          => E.Lift(rewriteBody e)              | E.Lift e          => E.Lift(rewriteBody e)
168              | E.Add es          => let val (change,body')= mkAdd(List.map rewriteBody es)          | E.Add es          => let
169                val (change,body')= mkAdd(List.map rewriteBody es)
170                     in if (change=1) then ( changed:=true;body') else body' end                     in if (change=1) then ( changed:=true;body') else body' end
171              | E.Sub(a, E.Field f)=> (changed:=true;E.Add[a, E.Neg(E.Field(f))])              | E.Sub(a, E.Field f)=> (changed:=true;E.Add[a, E.Neg(E.Field(f))])
172              | E.Sub(E.Sub(a,b),E.Sub(c,d))  => rewriteBody(E.Sub(E.Add[a,d],E.Add[b,c]))              | E.Sub(E.Sub(a,b),E.Sub(c,d))  => rewriteBody(E.Sub(E.Add[a,d],E.Add[b,c]))
# Line 179  Line 175 
175              | E.Sub (a,b)                   => E.Sub(rewriteBody a, rewriteBody b)              | E.Sub (a,b)                   => E.Sub(rewriteBody a, rewriteBody b)
176              | E.Div(e1 as E.Tensor(_,[_]),e2 as E.Tensor(_,[]))=>              | E.Div(e1 as E.Tensor(_,[_]),e2 as E.Tensor(_,[]))=>
177                      rewriteBody (E.Prod[E.Div(E.Const 1, e2),e1])                      rewriteBody (E.Prod[E.Div(E.Const 1, e2),e1])
178    
179              | E.Div(E.Div(a,b),E.Div(c,d))  => rewriteBody(E.Div(E.Prod[a,d],E.Prod[b,c]))              | E.Div(E.Div(a,b),E.Div(c,d))  => rewriteBody(E.Div(E.Prod[a,d],E.Prod[b,c]))
180              | E.Div(E.Div(a,b),c)           => rewriteBody (E.Div(a, E.Prod[b,c]))              | E.Div(E.Div(a,b),c)           => rewriteBody (E.Div(a, E.Prod[b,c]))
181              | E.Div(a,E.Div(b,c))           => rewriteBody (E.Div(E.Prod[a,c],b))              | E.Div(a,E.Div(b,c))           => rewriteBody (E.Div(E.Prod[a,c],b))
182              | E.Div (a, b)                  => E.Div(rewriteBody a, rewriteBody b)          | E.Div (a, b)                  => (E.Div(rewriteBody a, rewriteBody b))
   
183                  (**************Apply, Sum, Probe**************)                  (**************Apply, Sum, Probe**************)
184              | E.Apply(E.Partial [],e)   => e              | E.Apply(E.Partial [],e)   => e
185              | E.Apply(E.Partial d1, e1) =>              | E.Apply(E.Partial d1, e1) =>
186                  let                  let
187                  val e2 = rewriteBody e1                  val e2 = rewriteBody e1
188                  val (c,e3)=mkapply(E.Partial d1,e2)                  val (c,e3)=mkapply(E.Partial d1,e2)
189                  in (case c of 1=>(changed:=true;e3)| _ =>e3 (*end case*))              in
190                    (case c of 1=>(changed:=true;e3)| _ =>e3 (*end case*))
191                  end                  end
192              | E.Apply _                 => raise Fail" Not well-formed Apply expression"              | E.Apply _                 => raise Fail" Not well-formed Apply expression"
193              | E.Sum([],e)               => (changed:=true;rewriteBody e)              | E.Sum([],e)               => (changed:=true;rewriteBody e)
194              | E.Sum(c,e)                => let              | E.Sum(c,e)                => let
195                  val (c,e')=mkSum(c,rewriteBody e)                  val (c,e')=mkSum(c,rewriteBody e)
196                  in (case c of 0 => e'|_ => (changed:=true;e'))              in
197                    (case c of 0 => e'|_ => (changed:=true;e'))
198                  end                  end
199              | E.Probe(u,v)              =>              | E.Probe(u,v)              =>
200                  let                  let
# Line 218  Line 216 
216                  (changed := true; E.Add(List.map (fn e=> E.Prod([e1,e]@e3)) e2))                  (changed := true; E.Add(List.map (fn e=> E.Prod([e1,e]@e3)) e2))
217                | E.Prod(e1::E.Sub(e2,e3)::e4)=>                | E.Prod(e1::E.Sub(e2,e3)::e4)=>
218                  (changed :=true; E.Sub(E.Prod([e1,e2]@e4), E.Prod([e1,e3]@e4 )))                  (changed :=true; E.Sub(E.Prod([e1,e2]@e4), E.Prod([e1,e3]@e4 )))
   
   
219                  (*************Product EPS **************)                  (*************Product EPS **************)
220    
221                | E.Prod(E.Epsilon(i,j,k)::E.Apply(E.Partial d,e)::es)=>let                | E.Prod(E.Epsilon(i,j,k)::E.Apply(E.Partial d,e)::es)=>let
# Line 242  Line 238 
238                              val (_,b) = mkProd [E.Epsilon(i,j,k),a]                              val (_,b) = mkProd [E.Epsilon(i,j,k),a]
239                              in b end                              in b end
240                      end                      end
   
241                | 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])]=>
242                      if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0))              if(e2=i1 andalso e3=i2)
243                then (changed :=true;E.Const(0))
244                      else body                      else body
245    
246              | E.Prod(E.Epsilon eps1::ps)=> (case (G.epsToDels(E.Epsilon eps1::ps))              | E.Prod(E.Epsilon eps1::ps)=> (case (G.epsToDels(E.Epsilon eps1::ps))
247                  of (1,e,[],_,_)      =>(changed:=true;e)(* Changed to Deltas *)                  of (1,e,[],_,_)      =>(changed:=true;e)(* Changed to Deltas *)
248                  | (1,e,sx,_,_)      =>(changed:=true;E.Sum(sx,e))(* Changed to Deltas *)              | (1,e,sx,_,_)      =>(changed:=true;E.Sum(sx,e))
249                        (* Changed to Deltas *)
250                  | (_,_,_,_,[])   =>  body                  | (_,_,_,_,[])   =>  body
251                  | (_,_,_,epsAll,rest) => let                  | (_,_,_,epsAll,rest) => let
252                          val p'=rewriteBody(E.Prod rest)                          val p'=rewriteBody(E.Prod rest)
253                          val(_,b)= mkProd(epsAll@[p'])                          val(_,b)= mkProd(epsAll@[p'])
254                          in b end                          in b end
255                  (*end case*))                  (*end case*))
   
256              | E.Prod(E.Sum(c1,E.Prod(E.Epsilon e1::es1))::E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es) =>              | E.Prod(E.Sum(c1,E.Prod(E.Epsilon e1::es1))::E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es) =>
257                  (case G.epsToDels([E.Epsilon e1, E.Epsilon e2]@es1@es2@es)                  (case G.epsToDels([E.Epsilon e1, E.Epsilon e2]@es1@es2@es)
258                  of (1,e,sx,_,_)=> (changed:=true; E.Sum(c1@c2@sx,e))                  of (1,e,sx,_,_)=> (changed:=true; E.Sum(c1@c2@sx,e))
# Line 264  Line 260 
260                      val eA=rewriteBody(E.Sum(c1,E.Prod(E.Epsilon e1::es1)))                      val eA=rewriteBody(E.Sum(c1,E.Prod(E.Epsilon e1::es1)))
261                      val eB=rewriteBody(E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es))                      val eB=rewriteBody(E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es))
262                      val (_,e)=mkProd([eA,eB])                      val (_,e)=mkProd([eA,eB])
263                      in e                  in
264                        e
265                      end                      end
266                  (*end case*))                  (*end case*))
   
267              | E.Prod[E.Delta d, E.Neg e]=> (changed:=true;E.Neg(E.Prod[E.Delta d, e]))              | E.Prod[E.Delta d, E.Neg e]=> (changed:=true;E.Neg(E.Prod[E.Delta d, e]))
268              | E.Prod(E.Delta d::es)=>let              | E.Prod(E.Delta d::es)=>let
269                  val (pre',eps, dels,post)= filterGreek(E.Delta d::es)                  val (pre',eps, dels,post)= filterGreek(E.Delta d::es)
# Line 280  Line 276 
276                      | _ => (changed:=true;a )                      | _ => (changed:=true;a )
277                      (*end case*))                      (*end case*))
278                      end                      end
279          | E.Prod[e1,e2]=> let
280                | E.Prod[e1,e2]=> let val (_,b)=mkProd[rewriteBody e1, rewriteBody e2] in b end              val (_,b)=mkProd[rewriteBody e1, rewriteBody e2]
281                in b end
282                | E.Prod(e::es)=>let                | E.Prod(e::es)=>let
283                      val e'=rewriteBody e                      val e'=rewriteBody e
284                      val e2=rewriteBody(E.Prod es)                      val e2=rewriteBody(E.Prod es)
285                      val(_,b)=(case e2                      val(_,b)=(case e2
286                          of E.Prod p'=> mkProd([e']@p')                          of E.Prod p'=> mkProd([e']@p')
287                          |_=>mkProd [e',e2])                          |_=>mkProd [e',e2])
288                  in b              in
289                        b
290                     end                     end
291    
292              (*end case*))              (*end case*))
# Line 312  Line 310 
310  end  end
311    
312    
   
313  end (* local *)  end (* local *)

Legend:
Removed from v.2844  
changed lines
  Added in v.2845

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