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

SCM Repository

[diderot] View of /branches/charisee/src/compiler/mid-to-low/sca-to-low-set.sml
ViewVC logotype

View of /branches/charisee/src/compiler/mid-to-low/sca-to-low-set.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3624 - (download) (annotate)
Fri Jan 29 17:49:01 2016 UTC (4 years, 4 months ago) by jhr
File size: 6056 byte(s)
adding header comments in prep for merge
(* sca-to-low-set.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *)

  (*convert EIN with tensors, indexed as scalars to LowIL
*use Scalar ops like addSca, subSca..
*) 
structure ScaToLow =  struct
    local
    structure IL =  LowIL
    structure Ty =  LowILTypes
    structure Op =  LowOps
    structure Var =  LowIL.Var
    structure E =  Ein
    structure EtoFld =  FieldToLow
    structure H = Helper
    structure P = Printer
    structure IMap = IntRedBlackMap
    in

    fun evalField e =  EtoFld.evalField e
    fun mapIndex e = H.mapIndex e
    fun intToReal e = H.intToReal e
    fun indexTensor e = H.indexTensor e
    fun mkSubSca e =  H.mkSubSca e
    fun mkProdSca e = H.mkProdSca e
    fun mkDivSca e =  H.mkDivSca e
    fun mkMultiple e = H.mkMultiple e
    fun evalG e =  H.evalG e
    fun mkOp1 e =  H.mkOp1 e
    fun insert  (k, v) d =  IMap.insert (d, k, v)
    fun errField e = raise Fail ("Invalid Field Here:"^ (P.printbody e))

    (* general expressions*)
    fun generalfn (setOrig, dict, (e:Ein.ein, args:LowIL.var list)) = let
        val mapp = ref dict
        val info =  (e, args) 
        val params = Ein.params e
        fun gen (avail, body) =  let
            (*********sumexpression ********)
            fun tb n =  List.tabulate (n, fn e =>e)
            fun Sumcheck (avail, sumx, e) = let
                fun sumloop (avail, mapsum) = (mapp:= mapsum; gen (avail, e))
                fun sumI1 (avail, left, (v, [i], lb1), [], rest ) = let
                    val dict = insert (v, lb1+i)  left
                    val  (avail, vD) =  sumloop (avail, dict)
                    in  (avail, rest@[vD])  end
                |  sumI1 (avail, left, (v, i::es, lb1), [], rest) = let
                    val dict = insert (v, (i+lb1))  left
                    val  (avail, vD) = sumloop  (avail, dict)
                    in sumI1 (avail, dict, (v, es, lb1), [], rest@[vD])  end
                | sumI1 (avail, left, (v, [i], lb1), (E.V a, lb2, ub2) ::sx, rest) =
                    sumI1 (avail,  insert (v, lb1+i)  left, (a, tb (ub2-lb2+1), lb2), sx, rest)
                | sumI1 (avail, left, (v, s::es, lb1), (E.V a, lb2, ub2) ::sx, rest) = let
                    val dict = insert (v, (s+lb1))  left
                    val xx = tb (ub2-lb2+1) 
                    val  (avail, rest') = sumI1 (avail, dict, (a, xx, lb2), sx, rest)
                    in sumI1 (avail, dict, (v, es, lb1), (E.V a, lb2, ub2) ::sx, rest')  end
                | sumI1 _ = raise Fail"None Variable-index in summation"
                val  (E.V v, lb, ub) = hd (sumx) 
                in
                    sumI1 (avail, !mapp, (v, tb (ub-lb+1), lb), tl (sumx), [])
                end
            in  (case body
                of E.Field _          => errField (body)
                | E.Partial _          => errField (body) 
                | E.Apply _            => errField (body) 
                | E.Probe _            => errField (body) 
                | E.Conv _             => errField (body) 
                | E.Krn _              => errField (body) 
                | E.Img _              => errField (body) 
                | E.Lift _             => errField (body) 
                | E.Value v            => intToReal (avail, (mapIndex (E.V v, !mapp))) 
                | E.B (E.Const c)        => intToReal (avail, c) 
                | E.G e1               => evalG (avail, !mapp, e1) 
                | E.Tensor (id, ix)       => indexTensor (avail, !mapp, (params, args, id, ix, Ty.TensorTy []))
                | E.Op1 (E.Neg, e1)      =>
                    let
                        val (avail, vA) = gen (avail, e1)
                        val (avail, vB ) =  intToReal (avail, ~1)
                    in mkProdSca  (avail, [vB, vA])   end
                | E.Op1 (op1, e1)         => mkOp1 (op1, gen (avail, e1))
                | E.Op2 (E.Sub, e1, e2)   =>
                    let
                        val  (avail, vA) = gen (avail, e1)
                        val  (avail, vB) = gen (avail, e2)
                    in mkSubSca (avail, [vA, vB])   end
                | E.Opn (E.Add, e)       =>
                    let
                        fun iter (avail, [], ids) =  mkMultiple (avail, List.rev ids, Op.addSca, Ty.TensorTy [])
                          | iter (avail, e1::es, ids) = let
                            val  (avail, a) = gen (avail, e1)
                            in  iter (avail,es,a::ids) end
                    in iter (avail, e, []) end
                | E.Opn (E.Prod, e)      =>
                    let
                        fun iter (avail, [], ids) =  mkMultiple (avail, List.rev ids, Op.prodSca, Ty.TensorTy [])
                          | iter (avail, e1::es, ids) = let
                        val  (avail, a) = gen (avail, e1)
                        in  iter (avail,es,a::ids) end
                    in iter (avail, e, []) end
                | E.Op2 (E.Div, e1 as E.Tensor (_, [_]), e2 as E.Tensor (_, [])) =>
                        gen (avail, E.Opn (E.Prod, [E.Op2 (E.Div, E.B (E.Const 1), e2), e1]))
                | E.Op2 (E.Div, e1, e2)    =>
                    let
                        val  (avail, vA ) = gen (avail, e1)
                        val  (avail, vB) = gen (avail, e2)
                    in mkDivSca (avail, [vA, vB]) end
                | E.Sum (x, E.Opn (E.Prod, (E.Img (Vid, _, _) ::E.Krn (Hid, _, _) ::_)))
                                       => evalField (avail, !mapp, (body, info))
                | E.Sum (sumx, e)        =>
                    let
                        val (avail,ids)= Sumcheck (avail, sumx, e)
                    in mkMultiple (avail, ids, Op.addSca, Ty.TensorTy []) end
                | _                    => raise Fail"unsupported ein-exp "
                 (*end case*)) 
                end
         in
           gen (setOrig, E.body e) 
         end

end  (* local *) 

end

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