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

SCM Repository

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

View of /branches/charisee/src/compiler/ein/order-ein.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2584 - (download) (annotate)
Tue Apr 15 03:22:58 2014 UTC (5 years, 5 months ago) by cchiw
File size: 4688 byte(s)
Multiply Fields
(*Orders Ein Function after substitution*)
structure OrderEin = struct

    local

    structure E = Ein

    in


(*Orders the expression correctly.*)
fun orderfn(Ein.EIN{params, index, body})= let
  (* val _ = print "\n IN ORDER \n"*)
   val changed =ref false
   fun order(body)=(case body
        of E.Const _ => body
        | E.Tensor _=> body
        | E.Field _ => body
        | E.Krn _ => body
        | E.Delta _ => body
        | E.Value _ => body
        | E.Epsilon _=>body
        | E.Partial _ => body
        | E.Conv _=>body 
        | E.Sum(c1,E.Sum(c2, e))=>(changed:=true;E.Sum(c1@c2,order e))
        | E.Sum(sumIndex,E.Prod e)=> let
            (*val _ =print "\n NOPE"*)
            fun prodMatch(c,s,p,[])=let 
                val p'=case p of [e1] => e1
                    |_=> E.Prod p
                val result= (case s
                        of []=> E.Sum(sumIndex,p')
                        |_=> E.Prod(s@ [E.Sum(sumIndex,p')])
                        (*end case*))
                in (case c
                    of 1=> (changed:=true;result)
                        |_=> result)
                end
            | prodMatch(c,s,[],(E.Value v)::es)= prodMatch(c,s@[E.Value v],[], es)
            | prodMatch(c,s,p,(E.Value v)::es)= prodMatch(1,s@[E.Value v], p,es)
            | prodMatch(c,s,[],(E.Const v)::es)= prodMatch(c,s@[E.Const v],[], es)
            | prodMatch(c,s,p,(E.Const v)::es)= prodMatch(1,s@[E.Const v], p,es)
            | prodMatch(c,s,[],(E.Tensor(id,[]))::es)= prodMatch(c,s@[E.Tensor(id,[])], [],es)
            | prodMatch(c,s,p,(E.Tensor(id,[]))::es)= prodMatch(1,s@[E.Tensor(id,[])],p, es)
            | prodMatch(c,s,[],(E.Conv(v,[],h,[]))::es)=
                (prodMatch(c,s@[E.Conv(v,[],h,[])], [],es))
            | prodMatch(c,s,p,(E.Conv(v,[],h,[]))::es)=
                    (prodMatch(1,s@[E.Conv(v,[],h,[])],p, es))
            | prodMatch(c,s,[],(E.Probe(E.Conv(v,[],h,[]),E.Tensor(t,[])))::es)=
                (prodMatch(c,s@[E.Probe(E.Conv(v,[],h,[]),E.Tensor(t,[]))], [],es))
            | prodMatch(c,s,p,(E.Probe(E.Conv(v,[],h,[]),E.Tensor(t,[])))::es)=
                (prodMatch(1,s@[E.Probe(E.Conv(v,[],h,[]),E.Tensor(t,[]))],p, es))
            | prodMatch(c,s,p,E.Prod e::es)=  prodMatch(c,s,p,e@ es)
            | prodMatch(c,s,p,e::es)=  prodMatch(c,s,p@[e], es)
            val e'= order(E.Prod e)
            in (case e'
                of E.Prod p' => prodMatch (0,[],[],p')
                |_=>e')
            end
        | E.Sum(c,e)=>E.Sum(c, order e)
        | E.Neg e => E.Neg(order e)
        | E.Add es => E.Add (List.map order es)
        | E.Sub(e1,e2) => E.Sub(order e1, order e2)
        | E.Div(e1,e2)=> E.Div(order e1, order e2)
        | E.Apply(e1,e2)=> E.Apply(e1, order e2)
        | E.Probe(e1,e2)=> (print "\n probe \n"; E.Probe(order e1,order e2))
        | E.Img _ => body
        | E.Prod [e1]=>e1
        | E.Prod e=>let

            fun prodMatch(c,s,eps,dels,p,[])= (c,E.Prod(s@eps@dels@p))
            | prodMatch(c,s,eps,[],[],(E.Epsilon e)::es)=prodMatch(c,s,eps@[E.Epsilon e],[],[], es)
            | prodMatch(_,s,eps,dels,p,(E.Epsilon e)::es)=prodMatch(1,s,eps@[E.Epsilon e],dels,p, es)
            | prodMatch(c,s,eps,dels,[],(E.Delta d)::es)=prodMatch(c,s,eps,dels@[E.Delta d],[], es)
            | prodMatch(_,s,eps,dels,p,(E.Delta d)::es)=prodMatch(1,s,eps,dels@[E.Delta d],p, es)
            | prodMatch(c,s,[],[],[], (E.Value v)::es)= prodMatch(c,s@[E.Value v],[],[], [], es)
            | prodMatch(c,s,eps,dels,p, (E.Value v)::es)= prodMatch(1,s@[E.Value v],eps,dels, p, es)
            | prodMatch(c,s,[],[],[], (E.Const v)::es)= prodMatch(c,s@[E.Const v],[],[],[], es)
            | prodMatch(c,s,eps,dels,p, (E.Const v)::es)= prodMatch(1,s@[E.Const v],eps,dels, p, es)
            | prodMatch(c,s,[],[],[], (E.Tensor(id,[]))::es)= prodMatch(c,s@[E.Tensor(id,[])],[],[],[], es)
            | prodMatch(c,s,eps,dels,p, (E.Tensor(id,[]))::es)= prodMatch(1,s@[E.Tensor(id,[])],eps,dels, p, es)
            | prodMatch(c,s,eps,dels,p, (E.Prod e)::es)= prodMatch(c,s,eps,dels, p,e@es)
            | prodMatch(c,s,eps,dels,p, e::es)= prodMatch(c,s,eps,dels, p@[order e], es)
            val(change,result)=prodMatch (0,[],[],[],[],e)
            in (case change
                of 1=> (changed:=true;result)
                |_=> result) end
         (*end case*))

    fun loop body = let
    val body' = order body
        in
            if !changed
                then (changed := false; loop body')
            else body'
        end
        val b = loop body
        val b'=order b
   in (Ein.EIN{params=params, index=index, body=b'}) end

end (* local *)

end 

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