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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2844 - (download) (annotate)
Tue Dec 9 18:05:29 2014 UTC (4 years, 11 months ago) by cchiw
File size: 6288 byte(s)
code cleanup
(*
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])
fun insert (key, value) d =fn s =>
    if s = key then SOME value
    else d s

fun lookup k d = d k
val empty =fn key =>NONE


(*******************************************************************************************
* Group of functions that rewrites ein_exp
*)
(* mkAdd:ein_exp list->int* ein_exp
*Flattens Add constructor: change, expression
*)
fun mkAdd [e]=(1,e)
    | mkAdd(e)=let
    fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')
        |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(1))
        | [e] => (1,e)
        | es => (b,E.Add es)
        (* end case *)
     end
        
(* mkProd:ein_exp list->int* ein_exp
*Flattens Add constructor: change, expression
*)
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 orelse  0>c) then (3,[E.Const 0])
                else flatten(i,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*))

(*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)
          | _           => 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 *)

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