Home My Page Projects Code Snippets Project Openings diderot

SCM Repository

[diderot] View of /branches/charisee_dev/src/compiler/ein/filter-ein.sml
 [diderot] / branches / charisee_dev / src / compiler / ein / filter-ein.sml

View of /branches/charisee_dev/src/compiler/ein/filter-ein.sml

Tue Jan 19 01:24:00 2016 UTC (3 years, 7 months ago) by cchiw
File size: 6938 byte(s)
`clean up rules and generic outer product`
```(*
*A collection of Fiter function that are used to organize ein_exps
*Some of them are only use by 1 file and could be moved there
*Files include order-ein,normalize-ein,and move_sum
*)
structure Filter = struct
local

structure E = Ein
structure P=Printer
in

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

(************** Group of functions that rewrites ein_exp********)
*)
| flatten(i,((E.B(E.Const c)):: l'))=
if (c>0 orelse 0>c) then let
val (b,a)=flatten(i,l') in (b,[E.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.B(E.Const 0))
| [e] => (1,e)
(* end case *)
end

(* mkProd:ein_exp list->int* ein_exp
*)
fun mkProd [e]=(1,e)
| mkProd(e)=let
fun flatten(i,((E.Opn(E.Prod, l))::l'))= flatten(1,l@l')
| flatten(i,((E.B(E.Const 0))::l'))=(3,[E.B(E.Const 0)])
| flatten(i,((E.B(E.Const 1))::l'))=flatten(1,l')
| flatten(i,[])=(i,[])
| flatten (i,e::l') =  let val(a,b)=flatten(i,l') in (a,[e]@b) end
val (change,a)=flatten(0,e)
in if(change=3) then (1,E.B(E.Const(0)))
else case a
of [] => (1,E.B(E.Const(0)))
| [e] => (1,e)
| es => (change, E.Opn(E.Prod, es))
(* end case *)
end

(*rewriteProd: ein_exp list -> ein_exp
* rewrite. Prod A
*used by move_sum.sml
*)
fun rewriteProd A=(case A
of [A]=> A
| A => E.Opn(E.Prod, A)
(*end case*))

(*rewriteSum:sum_indexid list* ein_exp list -> ein_exp
* rewrite. Sum(c,Prod p))
*used by move_sum.sml
*)
fun rewriteSum(c,p)= E.Sum(c, rewriteProd p)

(*rewriteProdSum:ein_exp list*sum_indexid list* ein_exp list -> ein_exp
* rewrite. Prod( pre*Sum(out,Prod post))
*used by move_sum.sml
*)
fun rewriteProdSum(pre,_,[])=rewriteProd pre
| rewriteProdSum(pre,outer,post)=rewriteProd(pre@[rewriteSum(outer,post)])

(************************* Group of functions that filter product *******************************)

(* filterGreek:ein_exp list ->ein_exp list*ein_exp list*ein_exp list*ein_exp list
*filter scalars and greeks
*used by order-ein.sml
*)
fun filterGreek e= let
fun filter([],pre,eps,dels, post)=(pre,eps,dels ,post)
| filter(e1::es,pre,eps,dels, post)=(case e1
of E.Opn(E.Prod, p)                 => filter(p@es, pre, eps,dels,post)
| E.Field(_,[])                     => filter(es, pre@[e1], eps,dels,post)
| E.Conv(_,[],_,[])                 => filter(es, pre@[e1], eps,dels,post)
| E.Probe(E.Field(_,[]),_)          => filter(es, pre@[e1], eps,dels,post)
| E.Probe(E.Conv(_,[],_,[]),_)      => filter(es, pre@[e1], eps,dels,post)
| E.Tensor(id,[])                   => filter(es, pre@[e1], eps,dels,post)
| E.B(E.Const _)                      => filter(es, pre@[e1], eps,dels,post)
| E.G(E.Epsilon _)                    => filter(es, pre,eps@[e1],dels, post)
| E.G(E.Delta _)                      => filter(es, pre,eps,dels@[e1], post)
|  _                                => filter(es, pre, eps, dels, post@[e1])
(*end case *))
in
filter(e,[],[],[],[])
end

(*filterField:ein_exp list->ein_exp list * ein_exp list
* Note Lift indicates a Tensor
* So expression is either Lift, del, eps, or contains a Field
*used by order-ein.sml
*)
fun filterField e= let
fun filter([],pre,post)=(pre,post)
| filter(e1::es, pre,post)=(case e1
of E.Opn(E.Prod, p)     => filter(p@es, pre, post)
| E.Lift _            => filter(es, pre@[e1], post)
| E.G(E.Epsilon _)    => filter(es, pre@[e1], post)
| E.G(E.Eps2 _)         => filter(es, pre@[e1], post)
| E.G(E.Delta _ )        => filter(es, pre@[e1], post)
| E.B _               => filter(es, pre@[e1], post)
| _                   => filter(es,pre, post@[e1])
(*end case*))
in filter(e,[],[])
end

(*filterPartial:ein_exp list-> mu  list
* peels mu in partial expression
*)
fun filterPartial([])=[]
| filterPartial(E.Partial d1::es)=d1@filterPartial(es)
| filterPartial _= err"Found non-Partial in Apply"

(*filterEps:ein_exp list-> ein_exp list * ein_exp*ein_exp
* filters eps and other
* stops when we find embedded summation
*)
fun filterEps eps=let
fun findeps(eps,[],rest)                  = (eps,rest,[])
| findeps(eps,e1::es,rest)=(case e1
of (E.G(E.Epsilon eps1))              => findeps(eps@[e1],es,rest)
| E.Opn(E.Prod, p)                    => findeps(eps,p@es, rest)
| E.Field _                           => findeps(eps,es,rest@[e1])
| E.Tensor _                          => findeps(eps,es,rest@[e1])
| E.Sum(c,E.Opn(E.Prod,E.G(E.Epsilon eps1)::ps)) => (eps,rest@es,[e1])
|  _                                  => (eps,rest@[e1]@es,[])
(*end case*))
in
findeps([], eps,[])
end

(*filterSca:sum_index_is list * ein_exp-> int*ein_exp
*filter Scalars outside Summation product
*)
fun filterSca(c,e)= let
fun filter([],[],post)=(print"did not change in filter sca";(0,E.Sum(c,rewriteProd(post))))
| filter([],pre,post)=(print"changed in filter sca";(1,rewriteProdSum(pre,c,post)))
| filter(e1::es, pre,post)=(case e1
of E.Opn(E.Prod, p)             => filter(p@es, pre, post)
| E.Field(_,[])                 => filter(es, pre@[e1], post)
| E.Conv(_,[],_,[])             => filter(es, pre@[e1], post)
| E.Probe(E.Field(_,[]),_)      => filter(es, pre@[e1], post)
| E.Probe(E.Conv(_,[],_,[]),_)  => filter(es, pre@[e1], post)
| E.Tensor(id,[])               => filter(es, pre@[e1], post)
| E.B(E.Const _)                => filter(es, pre@[e1], post)
| _                             => filter(es,pre, post@[e1])
(*end case*))
in filter(e,[],[])
end
end

end (* local *)```