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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3682 - (download) (annotate)
Thu Feb 18 20:13:18 2016 UTC (4 years, 5 months ago) by cchiw
File size: 3123 byte(s)
creating stable branch that represents ein ir
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 b=(case b
            of E.B _                            => b
            | E.Tensor(id,alpha)                => E.Tensor(id, getAlpha alpha)
            | E.G(E.Delta(i,j) )                => E.G(E.Delta(getVx i,getVx j))
            | E.G(E.Epsilon(i,j,k))             => E.G(E.Epsilon(getIx  i,getIx  j,getIx k))
            | E.G(E.Eps2(i,j))                  => E.G(E.Eps2(getIx  i,getIx j))
            | E.Field (id,alpha)                => E.Field(id, getAlpha alpha)
            | E.Lift e1                         => E.Lift(rewriteExp e1)
            | E.Conv(v,alpha,h,dx)              => E.Conv (v, getAlpha alpha,h, getAlpha dx)
            | E.Partial dx                      => E.Partial (getAlpha dx)
            | E.Apply (e1,e2)                   => E.Apply(rewriteExp e1, rewriteExp e2)
            | E.Probe(E.Conv(v,alpha,h,dx) ,t)  => E.Probe(E.Conv (v, getAlpha alpha,h, getAlpha dx), rewriteExp t)
            | E.Probe (e1,e2)                   => E.Probe(rewriteExp e1, rewriteExp e2)
            | E.Value e1                        => raise Fail"Should not be here"
            | E.Img _                           => raise Fail "should not be here"
            | E.Krn _                           => raise Fail"Should not be here"
            | E.Sum(sx ,e1)                     => E.Sum(getSx sx ,rewriteExp e1)
            | E.Op1(E.PowEmb(sx1,n1), e1)       => E.Op1(E.PowEmb(getSx sx1,n1),rewriteExp e1)
            | E.Op1(op1, e1)                    => E.Op1(op1,rewriteExp e1)
            | E.Op2(op2, e1,e2)                 => E.Op2(op2,rewriteExp e1,rewriteExp e2)
            | E.Opn(opn, es)                    => E.Opn(opn,List.map rewriteExp es)
            (*end case*))
        in 
            rewriteExp e
        end

  end; (* local *)

end (* local *)

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