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/helper-set.sml
ViewVC logotype

View of /branches/charisee/src/compiler/mid-to-low/helper-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: 8491 byte(s)
adding header comments in prep for merge
(* helper-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.
 *)

 (*Helper functions*) 
structure Helper = struct
    local

    structure IL = LowIL
    structure Ty = LowILTypes
    structure Op = LowOps
    structure Var = LowIL.Var
    structure E = Ein
    structure IMap = IntRedBlackMap
    in

    fun err str = raise Fail (str)
    val empty = IMap.empty
    fun lookup k d = IMap.find (d, k) 
    fun insert  (k, v) d =  IMap.insert (d, k, v)
    fun find  (v, mapp) =  (case IMap.find (mapp, v) 
	   of NONE => raise Fail (concat["Outside Bound (", Int.toString v, ") "]) 
	    | SOME s => s
	   (* end *) ) 

     (*mapIndex:E.mu * dict-> int
    * lookup
    *) 
    fun mapIndex  (e1, mapp) =  (case e1
        of E.V e => find (e, mapp) 
         | E.C c => c
         (*end case*) ) 

    (*     *************************** IL.LIT ****************************  *)
     (* mkINt:int->Var*code list*) 
    fun mkInt  (avail, n) = let
        val lhs = IL.Var.new ("Int",  Ty.intTy) 
        val rhs = IL.LIT (Literal.Int (IntInf.fromInt n))
        in
           (avail,AvailRHS.addAssign avail (lhs, rhs))
        end
    fun mkReal  (avail, n) = let
        val lhs = IL.Var.new ("real", Ty.TensorTy []) 
        val rhs = IL.LIT (Literal.Int (IntInf.fromInt n) ) 
        in
            (avail,AvailRHS.addAssign avail (lhs, rhs))
        end
     (*     *************************** IL.CONS ****************************  *) 
    fun assgnCons (avail, pre, shape, args) = let
        val ty = Ty.TensorTy shape
        val lhs = IL.Var.new ("cons"^"_", ty) 
        val rhs = IL.CONS (ty, args) 
        in
           (avail,AvailRHS.addAssign avail (lhs, rhs))
        end

     (*     ***************************  IL.OP  ****************************  *) 
    fun assignOP (avail, opss, args, pre, ty) = let
        val lhs = IL.Var.new (pre, ty) 
        val rhs = IL.OP (opss, args) 
        in
            (avail,AvailRHS.addAssign avail (lhs, rhs))
        end
     (*     *************************** Op.IndexTensor ****************************  *) 
     (*getTensorTy:E.params*E.tensor_id-> LowIL.Ty
    * Integer, or Generic Tensor
    *) 
    fun getTensorTy (params, id) = case List.nth (params, id)
        of E.TEN (3, [shape]) => Ty.iVecTy (shape) (*FIX HERE*) 
        | E.TEN (_, shape) => Ty.TensorTy shape
        |_ => err "NONE Tensor Param"

     (* indexTensor:dict*string*E.params*Var list*E.tensor_id*E.alpha
    * ->Var*code list
    * Index Tensor at specific indices to give a scalar result
    *) 
    fun indexTensor (avail, _,  (params, args, id, [], ty) ) =  (avail, List.nth (args, id))
      | indexTensor (_, _,  ( params, args, id, [_, _, _], Ty.TensorTy [_, _, _, _] ) ) = raise Fail "uneven"
      | indexTensor (avail, mapp,  ( params, args, id, ix, ty) ) = let
        val ixx =  (List.map  (fn  (e1) => mapIndex (e1, mapp) ) ix)
        val argTy = getTensorTy (params, id) 
        val opp = Op.IndexTensor (id, ixx, argTy)
        val nU = List.nth (args, id)
        val name = String.concat["Indx_",String.concat (List.map Int.toString ixx), "_"]
        in
            assignOP (avail, opp, [nU], name, ty) 
        end
     (*     *************************** Op._ Shortcuts ****************************  *) 
    fun mkAddSca (avail, args) = assignOP (avail, Op.addSca, args, "addSca", Ty.TensorTy []) 
    fun mkAddInt (avail, args) = assignOP (avail, Op.addSca, args, "addInt",  Ty.intTy) 
    fun mkAddPtr (avail, args, ty) = assignOP (avail, Op.addSca, args, "addPtr", ty) 
    fun mkAddVec (avail, vecIX, args) = assignOP (avail, Op.addVec vecIX, args, "addV", Ty.TensorTy ([vecIX]) ) 
    fun mkSubSca (avail, args) = assignOP (avail, Op.subSca, args, "subSca", Ty.TensorTy []) 
    fun mkProdSca (avail, args) = assignOP (avail, Op.prodSca, args, "prodSca", Ty.TensorTy []) 
    fun mkProdInt (avail, args) = assignOP (avail, Op.prodSca, args, "prodInt",  Ty.intTy) 
    fun mkProdVec (avail, vecIX, args) = assignOP (avail, Op.prodVec vecIX, args, "prodV", Ty.TensorTy ([vecIX]) ) 
    fun mkDivSca (avail, args) = assignOP (avail, Op.divSca, args, "divSca", Ty.TensorTy []) 
    fun mkSumVec (avail, vecIX, args) = assignOP (avail, Op.sumVec vecIX, args, "sumVec", Ty.TensorTy []) 
     (*     *************************** Op. Other ****************************  *) 
    fun mkDotVec (avail, vecIX, args) = let
        val  (avail, vD) = mkProdVec (avail, vecIX, args)
        in  mkSumVec (avail, vecIX, [vD])  end
    fun intToReal (avail, n) = let
        val  (avail, vC) = mkReal (avail, n)
        in  assignOP (avail, Op.IntToReal, [vC], "cast", Ty.TensorTy [])  end
    fun mkPowInt ((avail, nU), nn) = let
        fun pow (1, avail) =  (avail, nU)
        | pow (2, avail) = let
            val opp = Op.prodSca
            val name = String.concat["_Pow2_"]
            in assignOP (avail, opp, [nU, nU], name,  Ty.intTy) end
        | pow (n, avail) = let
            fun half m = let
                val  (avail, vB) = pow (m div 2, avail)
                val opp = Op.prodSca
                val name = String.concat["_Pow", Int.toString (m), "_"]
                in assignOP (avail, opp, [vB, vB], name,  Ty.intTy) end
            in if  ((n mod 2) = 0) 
                then half n
                else let
                val  (avail, vC) = half (n-1)
                val opp = Op.prodSca
                val name = String.concat["_Pow", Int.toString (n), "_"]
                in  assignOP (avail, opp, [nU, vC], name,  Ty.intTy) end
            end

        in
            pow (nn, avail)
        end

    fun mkOp1 (E.PowInt n, e) = mkPowInt (e, n) 
      | mkOp1 (t, e) = let
        fun mkSingle (opp, name,  (avail, nU)) = assignOP (avail, opp, [nU], name, Ty.TensorTy [])
        val opp =  (case t
            of E.Cosine         => Op.Cosine
            | E.ArcCosine       => Op.ArcCosine
            | E.Sine            => Op.Sine
            | E.ArcSine         => Op.ArcSine
            | E.Tangent         => Op.Tangent
            | E.ArcTangent      => Op.ArcTangent
            | E.Sqrt            => Op.Sqrt
            | E.Exp             => Op.Exp
             (*end case*) ) 
        in  mkSingle (opp, "_op1_", e) end

     (*mkMultiple:string*Var list*LowOps.Op *ListIL.Ty -> Var*code list
    *apply rator between each items on list1
    *) 
    fun mkMultiple (availM, list1, rator, ty) = let
        fun add (avail, [],  _) = err"no element in mkMultiple"
        | add (avail, [e1], _) =  (avail, e1)
        | add (avail, [e1, e2], _) =  assignOP (avail, rator, [e1, e2], "mult", ty)
        | add (avail, e1::e2::es, count) = let
            val  (avail, vA) = assignOP (avail, rator, [e1, e2], String.concat["mult", Int.toString count], ty)
            in  add (avail, vA::es, count-1)
            end
        in
            add (availM, list1, List.length list1)
        end
     (*     *************************** Op. Greek ****************************  *) 
     (* deltaToInt:dict*E.mu*E.mu->int
    * delta function
    *) 
    fun deltaToInt (mapp, a, b) = let
        val i = mapIndex (a, mapp) 
        val j = mapIndex (b, mapp) 
        in if (i = j) then 1 else  0 end
    fun evalDelta (avail, mapp, a, b) = intToReal (avail, deltaToInt (mapp, a, b)) 
     (*eval Epsilon-2d*) 
    fun evalEps2 (avail, mapp, a, b) = let
        val i = mapIndex (E.V a, mapp) 
        val j = mapIndex (E.V b, mapp) 
        in if (i = j) then intToReal (avail, 0) 
            else
                if (j>i) then intToReal (avail, 1) 
                else intToReal (avail, ~1) 
        end
     (*eval Epsilon-3d*) 
    fun evalEps3 (avail, mapp, a, b, c) = let
        val i = mapIndex (E.V a, mapp) 
        val j = mapIndex (E.V b, mapp) 
        val k = mapIndex (E.V c, mapp) 
        in
            if (i = j orelse j = k orelse i = k) then intToReal (avail, 0) 
            else if (j>i) 
                then if (j>k andalso k>i) then intToReal  (avail, ~1) else intToReal (avail, 1) 
                else if (i>k andalso k>j) then intToReal (avail, 1) else intToReal (avail, ~1) 
        end
    fun evalG (avail, mapp, b) =  (case b
        of  E.Epsilon (i, j, k) => evalEps3 (avail, mapp, i, j, k) 
        |   E.Eps2 (i, j) => evalEps2 (avail, mapp, i, j) 
        |   E.Delta (i, j) => evalDelta (avail, mapp, i, j)
     (*end case*) ) 
 end

end

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