(* See if this is properly formed EIN Operator*)
structure checkEin = struct
    local
    structure E = Ein
    structure P=Printer

    in

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

fun err str=raise Fail str

fun checkEIN e=let

    val Ein.EIN{params=params, index=index, body=body}=e

    val size=length(index)

    fun mkMapp(0,mapp)=mapp
        | mkMapp(n,mapp)=let
        val dict=insert(n-1, 0) mapp
        in mkMapp(n-1,dict) end

    
    val mapp=mkMapp(size,empty)

    fun mkSumMapp([],mapp)=mapp
    | mkSumMapp((E.V n,_,_)::ns,mapp)=let
        val dict=insert(n, 0) mapp
        in mkSumMapp(ns,dict) end


    fun checkIndex([],dict)=dict
    | checkIndex(E.C _::es,dict)=checkIndex(es,dict)
    | checkIndex(E.V v::es,dict) = (case lookup v dict
        of SOME s=> let
            val d'=insert(v, s+1) dict
            in checkIndex(es,d')
            end
        | NONE => err(String.concat["\n Poorly written EIN Operator: Unknown Index ",Int.toString(v),":\n--",P.printerE(e),"\n"])
            (*end case*))


    fun checkKrnIndex([],dict)=dict
    | checkKrnIndex(E.C _::es,dict)=checkKrnIndex(es,dict)
    | checkKrnIndex(E.V v::es,dict) = (case lookup v dict
        of SOME s=> let
            val d'=insert(v, 2) dict
            in checkKrnIndex(es,d')
            end

    | NONE => err(String.concat["\n Poorly written EIN Operator: Unknown Index ",Int.toString(v),":\n--",P.printerE(e),"\n"])
    (*end case*))



    fun checkSumIndex([],dict)=dict
    | checkSumIndex((E.C _,_,_)::es,dict)=checkSumIndex(es,dict)
    | checkSumIndex((E.V v,_,_)::es,dict) = (case lookup v dict
        of SOME 2=> checkSumIndex(es,dict)
        | SOME c =>err(String.concat["\n Poorly written EIN Operator: Doesn't have two summation indices ",Int.toString(v),":\n--", "Just this many", Int.toString(c),P.printerE(e),"\n"])
        | _ => err(String.concat["\n Poorly written EIN Operator: Doesn't have two summation indices ",Int.toString(v),":\n--",P.printerE(e),"\n"])
        (*end case*))


    fun checkEin(body,mapp)=let

        fun add([],dict)=dict
        | add(e1::es,dict)=let
            val dict'=checkEin(e1, dict)
            in
                add(es, dict')
            end

        in (case body
        of E.Tensor(id, ix)  => checkIndex(ix,mapp)
        | E.Neg e            => checkEin(e,mapp)
        | E.Add e            => add(e,mapp)
        | E.Prod e           => add(e,mapp)
        | E.Sub (e1,e2)       => add([e1,e2],mapp)
        | E.Div(e1,e2)       => add([e1,e2],mapp)
        | E.Img(_,alpha,pos) => let
            val d'=checkIndex(alpha,mapp)
            in
                add(pos,d')
            end

        | E.Krn(_,delta,pos) => let
            val dels=List.map (fn(_, e)=>e) delta
            val mapp'=checkKrnIndex(dels, mapp)
            in checkEin(pos,mapp')
            end 
        | E.Const _         => mapp
        | E.Delta ( i, j)   => checkIndex([i, j], mapp)
        | E.Epsilon(i,j,k)  => checkIndex([E.V i, E.V j,  E.V k], mapp)
        | E.Value v         => checkIndex([E.V v], mapp)
        | E.Sum(sx,e)       => let
            val dict=mkSumMapp(sx,mapp)
            val d'=checkEin(e,dict)
            in
                checkSumIndex(sx,d')
            end
        | E.Conv _          => raise Fail "Conv- Should have been expanded"
        | E.Field _         => raise Fail "Field- Should have been expanded"
        | E.Partial _       => raise Fail "Partial- Should have been expanded"
        | E.Apply _         => raise Fail "Apply- Should have been expanded"
        | E.Lift _          => raise Fail "Lift- Should have been expanded"
        | E.Probe(e,x)      => raise Fail "Probe- Should have been expanded"
        (*end case*))
        end


    val newMapp=checkEin(body,mapp)
  

    fun checkMapp 0= 1
    | checkMapp n=let
        val n'=n-1
        in (case (lookup n' newMapp)
            of NONE  => raise Fail("Did not find Outer Index"^Int.toString(n))
            | SOME _ =>checkMapp n'
            (*end case*))
        end 


    in
        checkMapp size
    end

end (* local *)

end