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 2870 - (download) (annotate)
Wed Feb 25 21:47:43 2015 UTC (4 years, 7 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********)
    (* 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(0))
            | [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 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 *)

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