Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

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

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

Thu Apr 24 03:58:37 2014 UTC (5 years, 4 months ago) by cchiw
File size: 13024 byte(s)
`Added Lift Constructor`
```structure NormalizeEin = struct

local

structure E = Ein
structure P=Printer
structure F=Filter
structure G=EpsHelpers
in

fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])

fun prodAppPartial ([e1],p1)= E.Apply(E.Partial p1,e1)
| prodAppPartial((e1::e2),p1)=let
val l= prodAppPartial(e2,p1)
val (_,e2')= F.mkProd[e1,l]
val (_,e1')=F.mkProd(e2@ [E.Apply(E.Partial p1, e1)])
in
end

(*rewritten Sum*)
fun mkSum(c1,e1)=(case e1
of E.Conv _   => (0,E.Sum(c1,e1))
| E.Field _   => (0,E.Sum(c1,e1))
| E.Probe _   => (0,E.Sum(c1,e1))
| E.Apply _   => (0,E.Sum(c1,e1))
| E.Delta _   => (0,E.Sum(c1,e1))
| E.Epsilon _ => (0,E.Sum(c1,e1))
| E.Tensor _  => (0,E.Sum(c1,e1))
| E.Neg e2    => (1,E.Neg(E.Sum(c1,e2)))
| E.Lift e    => (1,E.Lift(E.Sum(c1,e)))
| E.Sum(c2,e2)=> (1,E.Sum(c1@c2,e2))
| E.Sub (a,b) => (1,E.Sub(E.Sum(c1,a),E.Sum(c1,b)))
| E.Div (a,b) => (1,E.Div(E.Sum(c1,a),E.Sum(c1,b)))
| E.Prod p     =>F.filterSca(c1,p)
| E.Const _   => err("Sum of Const")
| E.Partial _ => err("Sum of Partial")
| E.Krn _     => err("Krn used before expand")
| E.Value _   => err("Value used before expand")
| E.Img _     => err("Probe used before expand")
(*end case*))

(*rewritten Apply*)
fun mkapply(d1,e1)=(case e1
of E.Lift e   => (1,E.Const 0)
| E.Prod []   => err("Apply of empty product")
| E.Conv(v, alpha, h, d2)    =>let
val E.Partial d3=d1
in (1,E.Conv(v,alpha,h,d2@d3)) end
| E.Field _   => (0,E.Apply(d1,e1))
| E.Probe _   => (0,E.Apply(d1,e1))
| E.Apply(E.Partial d2,e2)  => let
val E.Partial d3=d1
in (1,E.Apply(E.Partial(d3@d2),e2)) end
| E.Neg e2    => (1,E.Neg(E.Apply(d1,e2)))
| E.Sum(c2,e2)=> (1,E.Sum(c2,E.Apply(d1,e2)))
| E.Sub (a,b) => (1,E.Sub(E.Apply(d1,a),E.Apply(d1,b)))
| E.Div (a,b) => (1,E.Div(E.Apply(d1,a),E.Apply(d1,b)))
| E.Prod p =>let
val (pre, post)= F.filterField p
val E.Partial d3=d1
in F.mkProd(pre@[prodAppPartial(post,d3)])
end
| E.Const _   => err("Const without Lift")
| E.Tensor _  => err("Tensor without Lift")
| E.Delta _   => err("Apply of Delta")
| E.Epsilon _ => err("Apply of Eps")
| E.Partial _ => err("Apply of Partial")
| E.Krn _     => err("Krn used before expand")
| E.Value _   => err("Value used before expand")
| E.Img _     => err("Probe used before expand")
(*end case*))

(*rewritten probe*)
fun mkprobe(e1,x)=(case e1
of E.Lift e   => (1,e)
| E.Prod []   => err("Probe of empty product")
| E.Prod p    => (1,E.Prod (List.map (fn(a)=>E.Probe(a,x)) p))
| E.Apply _   => (0,E.Probe(e1,x))
| E.Conv _    => (0,E.Probe(e1,x))
| E.Field _   => (0,E.Probe(e1,x))
| E.Sum(c,e') => (1,E.Sum(c,E.Probe(e',x)))
| E.Div (a,b) => (1,E.Div(E.Probe(a,x),E.Probe(b,x)))
| E.Sub (a,b) => (1,E.Sub(E.Probe(a,x),E.Probe(b,x)))
| E.Neg e'    => (1,E.Neg(E.Probe(e',x)))
| E.Const _   => err("Const without Lift")
| E.Tensor _  => err("Tensor without Lift")
| E.Delta _   => err("Probe of Delta")
| E.Epsilon _ => err("Probe of Eps")
| E.Partial _ => err("Probe Partial")
| E.Probe _   => err("Probe of a Probe")
| E.Krn _     => err("Krn used before expand")
| E.Value _   => err("Value used before expand")
| E.Img _     => err("Probe used before expand")
(*end case*))

(*print summation range*)
fun handleIndex e= (case e
of E.C(cx)=> String.concat["'",Int.toString(cx),"'"]
|  E.V(ix)=> Int.toString(ix)
(*end case *))

fun handleSumRange (mu,lb,ub)= print(String.concat[(handleIndex mu),"[",Int.toString(lb),"-",Int.toString(ub),"]"])
fun printSx e=(print "\n \$";List.map handleSumRange e; print "\$")

fun K gg=String.concatWith "," (List.map (fn (E.V e1,_,_)=> (Int.toString(e1))) gg)
fun Kt gg=List.map (fn e1=> print(String.concat["[", (K e1),"]"])) gg

(*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 _ = print(String.concat["\n IN NORMALIZE@", P.printbody(body),"@\n"])*)
val changed = ref false
val sumIndex=ref []

fun rewriteBody body =
(case body
of E.Const _=> body
| E.Tensor _ =>body
| E.Field _=> body
| E.Delta _ => body
| E.Epsilon _=>body
| E.Conv _=>body
| E.Partial _=>body
| E.Krn _ =>raise Fail"Krn before Expand"
| E.Img _ => raise Fail"Img before Expand"
| E.Value _=> raise Fail"Value before Expand"

(*************Algebraic Rewrites **************)
| E.Neg(E.Neg e)=> rewriteBody e
| E.Neg e => E.Neg(rewriteBody e)
| E.Lift e => E.Lift(rewriteBody e)
in if (change=1) then ( changed:=true;body') else body' end
| E.Sub(a, E.Field f)=> (changed:=true;E.Add[a, E.Neg(E.Field(f))])
| E.Sub (a,b)=>  E.Sub(rewriteBody a, rewriteBody b)
| 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),c)=> rewriteBody (E.Div(a, E.Prod[b,c]))
| E.Div(a,E.Div(b,c))=>  rewriteBody (E.Div(E.Prod[a,c],b))
| E.Div (a, b) => E.Div(rewriteBody a, rewriteBody b)

(**************Apply, Sum, Probe**************)
| E.Apply(E.Partial [],e)=> e
| E.Apply(E.Partial d1, e1)=>let
val e2 = rewriteBody e1
val (c,e3)=mkapply(E.Partial d1,e2)
in (case c of 1=>(changed:=true;e3)| _ =>e3 (*end case*))
end
| E.Apply(E.Prod e1,e2)=>E.Apply(E.Partial(F.filterPartial e1), rewriteBody e2)
| E.Sum([],e)=> (changed:=true;rewriteBody e)
| E.Sum(c,e)=>let
val ref x=sumIndex
val c'=[c]@x
val e'=(sumIndex:=c';rewriteBody e)
val ref s=sumIndex
val z=hd(s)
val (cng,e2)=(sumIndex:=tl(s);mkSum(z,e'))
in (case cng
of 1=> (changed:=true;e2)
|_=> e2
(*end case*))
end
| E.Probe(u,v)=>  let
val (c',b')=mkprobe(rewriteBody u,rewriteBody v)
in (case c'
of 1=> (changed:=true;b')
|_=> b'
(*end case*))
end

(*************Product**************)
| E.Prod [e1] => rewriteBody e1
| E.Prod((E.Div(e2,e3))::e4)=>
(changed :=true; E.Div(E.Prod([e2]@e4), e3 ))
(changed := true; E.Add(List.map (fn e=> E.Prod([e]@e3)) e2))
(changed := true; E.Add(List.map (fn e=> E.Prod([e1,e]@e3)) e2))
| E.Prod((E.Sub(e2,e3))::e4)=>
(changed :=true; E.Sub(E.Prod([e2]@e4), E.Prod([e3]@e4 )))
| E.Prod(e1::E.Sub(e2,e3)::e4)=>
(changed :=true; E.Sub(E.Prod([e1,e2]@e4), E.Prod([e1,e3]@e4 )))

(*************Product EPS **************)

(* Apply (d, e) shoudl be convereted to Conv operator *)
| E.Prod(E.Epsilon(i,j,k)::E.Apply(E.Partial d,e)::es)=>let
val change= G.matchEps(0,d,[],[i,j,k])
in case (change,es)
of (1,_) =>(changed:=true; E.Const 0)
| (_,[]) =>E.Prod[E.Epsilon(i,j,k),rewriteBody (E.Apply(E.Partial d,e))]
|(_,_)=> let
val a=rewriteBody(E.Prod([E.Apply(E.Partial d,e)]@ es))
val (_,b)=F.mkProd [E.Epsilon(i,j,k),a]
in b end
end
| E.Prod(E.Epsilon(i,j,k)::E.Conv(V,alpha, h, d)::es)=>let

val change= G.matchEps(0,d,[],[i,j,k])
in case (change,es)
of (1,_) =>(changed:=true; E.Const 0)
| (_,[]) =>E.Prod[E.Epsilon(i,j,k),E.Conv(V,alpha, h, d)]
| (_,_) =>let
val a=rewriteBody(E.Prod([E.Conv(V,alpha, h, d)]@ es))
val (_,b) = F.mkProd [E.Epsilon(i,j,k),a]
in b end
end

| E.Prod[(E.Epsilon(e1,e2,e3)), E.Tensor(_,[E.V i1,E.V i2])]=>
if(e2=i1 andalso e3=i2) then (changed :=true;E.Const(0))
else body

| E.Prod(E.Epsilon eps1::ps)=>
let

val ref x=sumIndex
val (i,s',e,rest)=G.epsToDels(x,body)
in (case (i, e,rest)
of (1,[e1],_) =>(changed:=true;sumIndex:=s';e1)
|(0,eps,[])=>body
| _ => let
val p'=rewriteBody(E.Prod rest)
val p''= (case p' of E.Prod p=>p |e=>[e])
val(_,b)= F.mkProd (e@p'')
in b end
(*end case*))
end
| E.Prod(E.Sum(c1,E.Prod(E.Epsilon e1::es1))::E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es)=>let
val ref x=sumIndex

val m= Kt x

val c'= [c1@c2]@x
val (i,s',e,rest)=G.epsToDels(c', E.Prod([E.Epsilon e1, E.Epsilon e2]@es1@es2@es))
val gsg=Kt s'

in (case (i, e,rest)
of (1,[e1],_)=> (changed:=true;sumIndex:=s';let
val ss=List.nth(s',((length s')-2))
in
E.Sum(ss,e1) end )
| _=>let
val eA=rewriteBody(E.Sum(c1,E.Prod(E.Epsilon e1::es1)))
val eB=rewriteBody(E.Prod(E.Sum(c2,E.Prod(E.Epsilon e2::es2))::es))
val (_,e)=F.mkProd([eA,eB])
in e
end
(*end case*))
end

| E.Prod(E.Delta d::es)=>let
val (pre',eps, dels,post)= F.filterGreek(E.Delta d::es)
val ref x=sumIndex
val (change,i',a)=G.reduceDelta(x, eps, dels, post)

in (case (change,a)
of (0, _)=> E.Prod [E.Delta d,rewriteBody(E.Prod es)]
| (_, E.Prod p)=>let
val (_, p') = F.mkProd p
in (changed:=true;sumIndex:=i';p') end
| _ => (changed:=true;sumIndex:=i';a )
(*end case*))
end

| E.Prod[e1,e2]=> let val (_,b)=F.mkProd[rewriteBody e1, rewriteBody e2] in b end
| E.Prod(e::es)=>let
val e'=rewriteBody e
val e2=rewriteBody(E.Prod es)
val(_,b)=(case e2
of E.Prod p'=> F.mkProd([e']@p')
|_=>F.mkProd [e',e2])
in b
end

(*end case*))

fun loop(body ,count) = let
val body' = rewriteBody body

in
if !changed
then (print(String.concat["\nN =>",Int.toString(count),"--",P.printbody(body')]);
changed := false ;sumIndex:=[];loop(body',count+1))
else (body',count)
end

val (b,count) = loop(body,0)
val _ = print(String.concat["\n out of normalize \n",P.printbody(b),"\n Final CounterXX:",Int.toString(count),"\n\n"])
in
(Ein.EIN{params=params, index=index, body=b},count)
end
end

end (* local *)```