(* ein-to-scalar.sml * * Generate LowIR scalar computations that implement Ein expressions. * * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu) * * COPYRIGHT (c) 2016 The University of Chicago * All rights reserved. *) structure EinToScalar : sig (* expand a scalar-valued Ein operator application to LowIR code; return the LowIR * vaiable that holds the result of the application (the assignments will be added * to avail). *) val expand : { avail : AvailRHS.t, (* the generated LowIR assignments *) mapp : int IntRedBlackMap.map, (* mapping from deBruijn indices to argument IDs *) body : Ein.ein_exp, (* the EIN operator body *) lowArgs : LowIR.var list (* corresponding LowIR arguments *) } -> LowIR.var end = struct structure IR = LowIR structure Ty = LowTypes structure Op = LowOps structure Var = LowIR.Var structure E = Ein structure Mk = MkLowIR structure IMap = IntRedBlackMap fun mapIndex (mapp, id) = (case IMap.find(mapp, id) of SOME x => x | NONE => raise Fail(concat["mapIndex(_, V ", Int.toString id, "): out of bounds"]) (* end case *)) fun expand {avail, mapp, body, lowArgs} = let (* val i = Mk.lookupMu (mapp, E.V 0) val _ = print(String.concat["\nin direction i:",Int.toString(i)])*) (* val j = Mk.lookupMu (mapp, E.V 1) val _ = print(String.concat["\nin direction i:",Int.toString(i),"-",Int.toString(j)]) *) fun gen (mapp, body) = let (*********sumexpression ********) fun tb n = List.tabulate (n, fn e => e) fun sumCheck (mapp, (v, lb, ub) :: sumx, e) = let fun sumloop mapp = gen (mapp, e) fun sumI1 (left, (v, [i], lb1), [], rest) = let val mapp = IMap.insert (left, v, lb1+i) val vD = gen (mapp, e) in rest@[vD] end | sumI1 (left, (v, i::es, lb1), [], rest) = let val mapp = IMap.insert (left, v, i+lb1) val vD = gen (mapp, e) in sumI1 (mapp, (v, es, lb1), [], rest@[vD]) end | sumI1 (left, (v, [i], lb1), (a, lb2, ub2) ::sx, rest) = sumI1 (IMap.insert (left, v, lb1+i), (a, tb (ub2-lb2+1), lb2), sx, rest) | sumI1 (left, (v, s::es, lb1), (a, lb2, ub2) ::sx, rest) = let val mapp = IMap.insert (left, v, s+lb1) val xx = tb (ub2-lb2+1) val rest' = sumI1 (mapp, (a, xx, lb2), sx, rest) in sumI1 (mapp, (v, es, lb1), (a, lb2, ub2) ::sx, rest') end | sumI1 _ = raise Fail "None Variable-index in summation" in sumI1 (mapp, (v, tb (ub-lb+1), lb), sumx, []) end in case body of E.Value v => Mk.intToRealLit (avail, mapIndex (mapp, v)) | E.Const c => Mk.intToRealLit (avail, c) | E.Delta(i, j) => Mk.delta (avail, mapp, i, j) | E.Epsilon(i, j, k) => Mk.epsilon3 (avail, mapp, i, j, k) | E.Eps2(i, j) => Mk.epsilon2 (avail, mapp, i, j) | E.Tensor(id, ix) => Mk.tensorIndex (avail, mapp, List.nth(lowArgs, id), ix) | E.Zero _ => Mk.intToRealLit (avail, 0) | E.Op1(op1, e1) => let val arg = gen (mapp, e1) in case op1 of E.Neg => Mk.realNeg (avail, arg) | E.Sqrt => Mk.realSqrt (avail, arg) | E.Cosine => Mk.realCos (avail, arg) | E.ArcCosine => Mk.realArcCos (avail, arg) | E.Sine => Mk.realSin (avail, arg) | E.ArcSine => Mk.realArcSin (avail, arg) | E.Tangent => Mk.realTan (avail, arg) | E.ArcTangent => Mk.realArcTan (avail, arg) | E.Exp => Mk.realExp (avail, arg) | E.PowInt n => Mk.intPow (avail, arg, n) | E.Abs => Mk.realAbs(avail, arg) (* end case *) end | E.Op2(E.Sub, e1, e2) => Mk.realSub (avail, gen (mapp, e1), gen (mapp, e2)) | E.Opn(E.Add, es) => Mk.reduce (avail, Mk.realAdd, List.map (fn e => gen(mapp, e)) es) | E.Opn(E.Prod, es) => Mk.reduce (avail, Mk.realMul, List.map (fn e => gen(mapp, e)) es) | E.Op2(E.Div, e1 as E.Tensor (_, [_]), e2 as E.Tensor (_, [])) => gen (mapp, E.Opn(E.Prod, [E.Op2 (E.Div, E.Const 1, e2), e1])) | E.Op2(E.Div, e1, e2) => Mk.realDiv (avail, gen (mapp, e1), gen (mapp, e2)) | E.Sum(sx, E.Opn(E.Prod, (img as E.Img _) :: (kargs as (E.Krn _ :: _)))) => FieldToLow.expand { avail = avail, mapp = mapp, sx = sx, img = img, krnargs = kargs, args = lowArgs } | E.Sum(sumx, e) => Mk.reduce (avail, Mk.realAdd, sumCheck (mapp, sumx, e)) | E.Probe(E.Epsilon e1, e2) => gen(mapp,E.Epsilon e1) | E.Probe(E.Eps2 e1, e2) => gen(mapp,E.Eps2 e1) | E.Probe(E.Const e1, e2) => gen(mapp, E.Const e1) | E.Probe(E.Delta e1, e2) => gen(mapp, E.Delta e1) | E.Probe e => raise Fail("probe ein-exp: " ^ EinPP.expToString body) | E.Field _ => raise Fail("field should have been replaced: " ^ EinPP.expToString body) | E.Poly(id, alpha, n, []) => let val t = E.Tensor(id, alpha) val ts = List.tabulate (n, fn _ => t) in gen(mapp, E.Opn(E.Prod, ts)) end | E.Poly(id, [], 1, [vx]) => gen(mapp, E.Const 1) (* derivative of a scalar? *) | E.Poly(id, [E.C c], n, [vx]) => let val dx = Mk.lookupMu (mapp, vx) val _ = print(String.concat["\n\t Poly1_", Int.toString(c),"^",Int.toString(n),"-dx",Int.toString(dx)]) val ec = E.Const n val t = E.Tensor(id, [E.C c]) val ts = List.tabulate (n-1, fn _ => t) val e = if(dx=c) then (case n of 1 => E.Const 1 | _ => E.Opn(E.Prod, ec::ts) (* end case *)) else E.Const 0 (* here need to implement partial derivative in respect to an axis *) in gen(mapp, e) end | _ => raise Fail("unsupported ein-exp: " ^ EinPP.expToString body) (*end case*) end in gen (mapp, body) end end
Click to toggle
does not end with </html> tag
does not end with </body> tag
The output has ended thus: (*end case*) end in gen (mapp, body) end end