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

SCM Repository

[diderot] View of /branches/charisee/src/compiler/ein/rewriteIndices.sml
ViewVC logotype

View of /branches/charisee/src/compiler/ein/rewriteIndices.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2870 - (download) (annotate)
Wed Feb 25 21:47:43 2015 UTC (4 years, 5 months ago) by cchiw
File size: 2996 byte(s)
added sqrt,pow, and examples
structure rewriteIndices= struct

    local
   
    structure E = Ein
    structure P=Printer
    structure S=getShape

    in
    val testing=0
    fun iTos i =Int.toString i
    fun lookup k d = d k
    fun err str=raise Fail str
    fun testp n=(case testing
        of 0=> 1
        | _ =>(print(String.concat n);1)
        (*end case*))

    (*dictionary to lookup mapp*)
    fun lkupIndexSingle(e1,mapp,str)=(case (lookup e1 mapp)
        of SOME l=>l
        | _=> raise Fail(str^iTos(e1))
        (*endcase*))
    fun lkupIndexV(E.V e1,mapp,str)=E.V (lkupIndexSingle(e1,mapp,str))
      | lkupIndexV(E.C e1,mapp,_)=E.C e1
    fun lkupIndexSx([],mapp,str)=[]
      | lkupIndexSx((E.V e1,ub,lb)::es,mapp,str)=(case (lookup e1 mapp)
            of SOME l =>[(E.V l,ub,lb)]@lkupIndexSx(es, mapp,str)
            |_ =>[]@lkupIndexSx(es, mapp,str)
            (*end case*))

    (* rewriteIndices:dict*ein_exp ->ein_exp
    *  rewrites indices in e using mapp
    *)
    fun rewrite(mapp,e)=let

        val str="Error indexMapp from expression:"^P.printbody e^"Index"
        fun getAlpha alpha = List.map (fn e=>lkupIndexV(e,mapp,str)) alpha
        fun getIx ix= lkupIndexSingle(ix,mapp,str)
        fun getVx ix= lkupIndexV (ix,mapp,str)
        fun getSx sx =lkupIndexSx(sx,mapp,str)
        fun rewriteExp e=(case e
            of E.Tensor(id,alpha)  => E.Tensor(id, getAlpha alpha)
            | E.Add e              => E.Add(List.map rewriteExp e)
            | E.Sub(e1,e2)         => E.Sub(rewriteExp e1,rewriteExp e2)
            | E.Div(e1,e2)         => E.Div(rewriteExp e1,rewriteExp e2)
            | E.Sum(sx ,e)         => E.Sum(getSx sx ,rewriteExp e)
            | E.Prod e             => E.Prod(List.map rewriteExp e)
            | E.Neg e              => E.Neg(rewriteExp e)
            | E.Probe(E.Conv(v,alpha,h,dx) ,t)    => E.Probe(E.Conv (v, getAlpha alpha,h, getAlpha dx), rewriteExp t)
            | E.Delta(i,j)         => E.Delta(getVx i,getVx j)
            | E.Epsilon(i,j,k)     => E.Epsilon(getIx  i,getIx  j,getIx k)
            | E.Eps2(i,j)          => E.Eps2(getIx  i,getIx  j)
            | E.Sqrt e             => E.Sqrt(rewriteExp e)
            | E.PowInt(e,n1)       => E.PowInt(rewriteExp e,n1)
            | E.PowReal(e,n1)      => E.PowReal(rewriteExp e,n1)
            | E.Const _            => e
             | E.ConstR _            => e
            | E.Field _            => E.Const 0
            | E.Partial _          => E.Const 0
            | E.Apply _            => E.Const 0
            | E.Lift _             => E.Const 0
            | E.Probe _            => E.Const 0
            | E.Conv _             => E.Const 0
            | E.Img _              => raise Fail "should not be here"
            | E.Value e1           => raise Fail"Should not be here"
            | E.Krn _              => raise Fail"Should not be here"
            (*end case*))
        in 
            rewriteExp e
        end

  end; (* local *)

end (* local *)

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