Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

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

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

Wed Feb 25 21:47:43 2015 UTC (4 years, 5 months ago) by cchiw
File size: 7089 byte(s)
`added sqrt,pow, and examples`
```(*
*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.Const c):: l'))=
if (c>0 orelse 0>c) 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(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.Prod l)::l'))= flatten(1,l@l')
| flatten(i,((E.Const 0)::l'))=(3,[E.Const 0])
| flatten(i,((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.Const(0))
else case a
of [] => (1,E.Const(0))
| [e] => (1,e)
| es => (change, 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.Prod A
(*end case*))
(*
fun mkProd e=let
fun flatten([],[])=(1,E.Const 1)
| flatten([],rest)=(0,rewriteProd rest)
| flatten((E.Const 0)::es,_)=(1,E.Const 0)
| flatten((E.Const 1)::es,rest)=flatten(es, rest)
| flatten((E.Prod p)::es,rest)=flatten(p@es,E.Prod rest)
| flatten(e1::es,rest)=flatten(es,rest@[e1])
in
flatten(e,[])
end
*)
(*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.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.Const _                     => filter(es, pre@[e1], eps,dels,post)
| E.Epsilon _                   => filter(es, pre,eps@[e1],dels, post)
| 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.Prod p     => filter(p@es, pre, post)
| E.Lift _    => filter(es, pre@[e1], post)
| E.Epsilon _ => filter(es, pre@[e1], post)
| E.Eps2 _ => filter(es, pre@[e1], post)
| E.Delta _   => filter(es, pre@[e1], post)
| E.Const _   => 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.Epsilon eps1)                   => findeps(eps@[e1],es,rest)
| 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.Prod(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)=(0,E.Sum(c,rewriteProd(post)))
| filter([],pre,post)=(1,rewriteProdSum(pre,c,post))
| filter(e1::es, pre,post)=(case e1
of 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.Const _                     => filter(es, pre@[e1], post)
| _                             => filter(es,pre, post@[e1])
(*end case*))
in filter(e,[],[])
end
end

end (* local *)```