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

SCM Repository

[diderot] View of /branches/charisee/src/compiler/c-target/opr-to-clang.sml
ViewVC logotype

View of /branches/charisee/src/compiler/c-target/opr-to-clang.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2870 - (download) (annotate)
Wed Feb 25 21:47:43 2015 UTC (4 years, 7 months ago) by cchiw
File size: 13857 byte(s)
added sqrt,pow, and examples
(*Tree-IL Opr expression to CLang Declarations *)

structure OprToClang= struct

    structure CL = CLang
    structure Op = TreeOps
    structure Ty = TreeILTypes
    structure IL=TreeIL
    structure ILF=TreeFunc
    structure N=CNames
   
    fun q n =Int.toString n
    val default=CL.D_NotDone

    (*-------------- Types ---------------*)
    val realTy=CL.T_Named(N.mkReal)
    val star=CL.T_Ptr realTy
    val intTy = CL.intTy
    val voidTy=CL.voidTy
   (* fun vecTy d= CL.T_Named(N.LocalTy [d])
    fun cfnTy d= CL.T_Named(N.cfnTy [d])*)
    fun vecTy d= CL.T_Named(N.cfnTy [d])
    fun unionTy d  = CL.T_Named(N.unionTy d)
    fun mkInt i =CL.mkInt(IntInf.fromInt i)

    (*-------------- var:strings ---------------*)
    val varR="r"   (*reals*)
    val varV="v"  (*vector*)
    val varI="i"  (*int*)
    val varA="a" (*float*)
    val varA2="b" (*float*)
    val varU="u" (*unionTy*)

    (*mkVars: int*str -> var list *)
    fun mkvars (n,pre)= List.tabulate(n ,(fn e=> (String.concat[pre,q e])))
 
    (*-------------- E_VAR:exp ---------------*)
    fun varToVar e =CL.E_Var e
    fun varToVars e=List.map (fn e1=>varToVar e1) e
    val VarR = varToVar varR
    val VarV = varToVar varV
    val VarI = varToVar varI
    val VarA = varToVar varA
    val VarA2= varToVar varA2
    val VarU = varToVar varU 

    (*-------------- Params ---------------*)
    (* mkParams:(attr list, ty, var)-> CL.PARAM List
    * creates Params
    *)
    fun mkParam e= CL.PARAM e
     fun mkParams e=List.map (fn e1=> mkParam e1) e
    (*Params created from vars*)
    val ParamR=mkParam ([],realTy,varR)  (*Real R *)
    fun ParamV n =mkParam([],vecTy n, varV) (*vector v*)
    val ParamI=mkParam([],intTy, varI)   (*Int i*)
    val ParamA=mkParam([], star,varA) (*float ptr * a *)
    val ParamA2=mkParam([], star,varA2) (*float ptr * b*)
    fun mkParamsSameType(ty,args)=List.map (fn e=>mkParam([],ty,e)) args

    (*mkVarParams: int*int-> CL.Exp * CL.PARAM list
    * creates "n" CL.Vars exps and Params, with shape "size"
    *)
    fun mkVarParams(size,n) =let
        val vars=mkvars (n,"v_")
        val paramTy=vecTy size
        val Params= mkParamsSameType(paramTy,vars)
        in
            (varToVars vars,Params)
        end
 
    (*-------------- Exp functions ---------------*) 
     (* mkProd: exp *exp ->  exp
     *create operators
     *)
     fun mkProd(a,b)=CL.mkBinOp(a, CL.#*, b)
     fun mkSub(a,b)= CL.mkBinOp(a, CL.#-, b)
     fun mkAdd(a,b)= CL.mkBinOp(a, CL.#+, b)
     fun mkAddM [a]=a
     | mkAddM (a::b::es)= mkAddM (CL.mkBinOp(a, CL.#+, b)::es)
     
     fun mkRtn e=CL.S_Return(SOME e)
     val voidRtn =CL.S_Return NONE
     
     fun setEq([],[])=[]
     | setEq (l::lhs, r::rhs)=[CL.S_Eq (l ,r)]@ setEq(lhs,rhs)
     | setEq _ =[]
     
     (*mkCastStruct:ClangTy, exp list -> exp
     * Create a cast expression
     *)
     fun mkCast(ty,body)=CL.E_Cast(ty, body)
     fun mkCastStruct(ty,body)= mkCast(ty, (CL.E_Struct body))
     
     (*mkExtVar:int*var *Var ->CL.S* CL.E
     *ty:vectTy n  u = (ty) a
     *)
     fun mkExtVar(n, u,VarA)=let
        val uty=unionTy n
        val e1=CL.E_TyVar(uty,u)
        val exp=mkCast(uty, VarA)
        val e2=CL.E_Ext exp
        val C= CL.S_Eq (e1, e2)
        val C4=  CL.S_Exp(CL.E_AssignOp  (e1, CL.$=,e2))
        in
            (C, CL.E_Var (u^".r"))
        end
     
     (*indexDiderotType:var* int-> CL.E
     *Index var at position 
     *)
    fun indexDiderotType(U,n)=List.tabulate(n,(fn e=> CL.E_Subscript(U,mkInt e)))
    fun indexDiderotTypeWithOffset(U,0,I)= []
      | indexDiderotTypeWithOffset(U,1,I)=[CL.E_Subscript(U,I)]
      | indexDiderotTypeWithOffset(U,n,I)=
        indexDiderotTypeWithOffset(U,n-1,I)@[CL.E_Subscript(U,mkAdd(mkInt(n-1),I))]
     
    (*mkZero:int -> exp
    *mk List of 0 expressions
    *)
    fun mkZero n=let
        val z=mkInt 0
        in
            List.tabulate (n,fn _=> z)
        end
     
    (*createDec:Ty,string, exp list, exp list ->CL.D_Func
     *create a CLang Declaration
    *)
    fun createDec(rtnType, fnName, params,blk)=   CL.D_Func([],rtnType,fnName,params,CL.S_Block blk)

      (*-------------- vector operations ---------------*)
     (*mkScaV:int-> CL.D_Func
     *Creates body for scalar function
     * scalar*vector->vector
     *)
     fun mkScaV d= let
        val rtnType= vecTy d
        val fnName=N.NameScaV d
        val params=[ParamR,ParamV d]
        val varList=List.tabulate(d, (fn _=>VarR))
        val fnCall=N.NameConsVec d
        val s=CL.E_Apply(fnCall, varList)
        val rtn=mkRtn(mkProd(s,VarV))
        in
            createDec(rtnType, fnName, params,[rtn])
        end
     
     (*mkScaV:int*int-> CL.D_Func
     *oSize is the shape of the vector argument
     *nSize is the number of elements being added
     *Creates body for summation function
     *vector->real
     *)
    fun mkSumV(nSize,oSize)= let
     val rtnType= realTy
     val fnName=N.NameSumV oSize
     val n=length(nSize)
     val vs=List.tabulate(n,fn n=> String.concat["v_",q n])
     val us=List.tabulate(n,fn n=>( String.concat["u_",q n]))
 
 
     val params=ListPair.map  (fn (n,v)=>mkParam([],vecTy n,v)) (nSize, vs)
     fun getExt([],[],[],uexp,indexp)=(uexp,indexp)
        | getExt(n1::ns,v1::vs,u1::us,uexp,indexp)=let
            val (e,VarUR)=mkExtVar(n1, u1,CL.E_Var v1)
            val indexedVec=indexDiderotType(VarUR,n1)
            in
                getExt(ns,vs,us,uexp@[e],indexp@indexedVec)
            end
 
     val (uexp,indexp)=getExt(nSize,vs,us,[],[])
     val rtn=mkRtn(mkAddM indexp)
     in
         createDec(rtnType, fnName, params,uexp@[rtn])
     end
 
 (*original 
    fun mkSumV(nSize,oSize)= let
        val rtnType= realTy
        val fnName=N.NameSumV oSize
        val params=[ParamV nSize]
        val (e,VarUR)=mkExtVar(nSize, varU,VarV)
        val indexedVec=indexDiderotType(VarUR,oSize)
        val rtn=mkRtn(mkAddM indexedVec)
        in
            createDec(rtnType, fnName, params,[e,rtn])
        end
 *)

     (*mkFloorV:int-> CL.D_Func
     *Creates body for Floor function
     * vector->vector
     *)
    fun mkFloorV d= let
        val fnName=N.NameFloorV d
        val rtnType= vecTy d
        val params=[ParamV d]
        val (e,VarUR)=mkExtVar(d, varU,VarV)
        val indexedVec=indexDiderotType(VarUR,d)
        val f=List.map (fn e=> CL.mkApply(N.NameFloor, [e])) indexedVec
        val body'= mkCastStruct(rtnType,f)
        val rtn= mkRtn(CL.E_Ext(body'))
        in
            createDec(rtnType, fnName, params,[e,rtn])
        end
     
     (*mkLerpV:int-> CL.D_Func
     *Creates body for Floor function
     * real*real*vector->vector
     *)
     fun mkLerpV d =let
        val fnName=N.NameLerpV d
        val rtnType= vecTy d
        val ([a,b],params)=mkVarParams(d,2)
        val s= mkSub(b,a)
        val f=CL.mkApply(N.NameScaV d , [VarR, s])
        val rtn=mkRtn(mkAdd(a,f))
        in
            createDec(rtnType, fnName, [ParamR]@params,[rtn])
        end
 
    fun size n=foldl (fn (a,b) => b*a) 1 n
     
     (* mkZeroOp:ty-> CL.D_Func
     *Creates body for zero function
     * array->void
     *)
     fun mkZeroOp ty=let
        val s=size ty
        val fnName =N.NameZeroV ty
        val rtnType= voidTy
        val lhs=indexDiderotType(VarA, s)
        val rhs=mkZero s
        val e=setEq(lhs,rhs)
        in
            createDec(rtnType, fnName, [ParamA],e@[voidRtn])
        end
     
     (* mkZeroOp:int-> CL.D_Func
     *Creates body for clamp function
     * vecs0,vec1,vec2-> vec 
     *)
    fun mkClampV d =let
        val fnName=N.NameClampV d
        val rtnType= vecTy d
        val ([V0,V1,V2],params)=mkVarParams(d,3)
        val [U0,U1,U2]=mkvars (3,"u")
        val (exp0,UR0)=mkExtVar(d, U0, V0)
        val (exp1,UR1)=mkExtVar(d, U1, V1)
        val (exp2,UR2)=mkExtVar(d, U2, V2)
        val e=[exp0,exp1,exp2]
        val A=indexDiderotType(UR0,d)
        val B=indexDiderotType(UR1,d)
        val C=indexDiderotType(UR2,d)
        
        val fnNameR=N.clamp 1
        fun callfn([],[],[])=[]
          | callfn(a1::aes, b1::bes, c1::ces)= let
            val f=CL.mkApply(fnNameR, [a1,b1,c1])
            in   [f]@callfn(aes,bes, ces) end
        val f=callfn(A,B,C)
        val body'= mkCastStruct(rtnType,f)
        val rtn= mkRtn(CL.E_Ext(body'))
        in
            createDec(rtnType, fnName, params,e@[rtn])
        end
     
     (* mkCopy:int-> CL.D_Func
     *Creates body for copy function
     * array*array*int->void
     *)
     fun mkCopy d= let
        val fnName=N.NameCopyTensor [d]
        val rtnType= voidTy
        val params=[ParamA,ParamA2,ParamI]
        val rhs= indexDiderotType(VarA2,d)
        val lhs=indexDiderotTypeWithOffset(VarA, d,VarI)
        val e=setEq(lhs,rhs)
        in
            createDec(rtnType, fnName, params,e)
        end
     
               (*-------------- Dec functions from CONS ---------------*)
     (*realToArr:int-> CL.D_Func
     *Creates body for Cons function
     * arr*real...->void
     *)
    fun realToArr n=let
        val rtnType= voidTy
        val fnName=N.NameConsArray n
        val vars=mkvars(n,varR)
        val rhs=varToVars vars
        val params=[ParamA]@ mkParamsSameType(realTy, vars)
        val lhs=indexDiderotType(VarA, n)
        val stmts=setEq(lhs,rhs)
        in
            createDec(rtnType, fnName, params,stmts@[voidRtn])
        end 
 
     (*realToVec:int-> CL.D_Func
     *Creates body for ConsV function
     * real->vecTY
     *)
    fun realToVec d=let
        val rtnType= vecTy d
        val fnName=N.NameConsVec d
        val vars=mkvars(d,varR)
        val params=mkParamsSameType(realTy, vars)
        val VARS=varToVars vars
        val body'= mkCastStruct(rtnType,VARS)
        val rtn= mkRtn(CL.E_Ext(body'))
        in
            createDec(rtnType, fnName, params,[rtn])
        end
 
            (*-------------- Dec functions from LDVec ---------------*)
    (*ldVec:int*int *int* Var* Var->CL.S
    * Does Load when not aligned
    *)
     fun ldVec(tyNew,tyOrig,rtnType,VarA,VarI) =let
        fun fillVec var=let
            val indexedVec=indexDiderotTypeWithOffset(var,tyOrig,VarI)
            val fill=mkZero(tyNew-tyOrig)
            in
                indexedVec@fill
            end
        fun sliceVec var= indexDiderotTypeWithOffset(var,tyNew,VarI)
        val pieces= if (tyNew>tyOrig) then fillVec VarA else sliceVec VarA
        in
            [mkRtn (mkCastStruct(rtnType,pieces))]
        end
  
    (*ldVec:int*int *int* Var* Var->CL.D_Func
    * General LoadVecVec
    * Array*int-> Vec
    *)
    fun generalldVec(A,tyNew,tyOrig) =let
        val rtnType= vecTy tyNew
        val fnName=N.NameLdArr(A,tyNew,tyOrig)
        val stmts=(case A
            of false =>ldVec(tyNew,tyOrig,rtnType,VarA,VarI)
           | true => [mkRtn (CL.E_Ref(vecTy tyNew,CL.E_Subscript(VarA,VarI)))]
            (*end case*))
        val params=[ParamA,ParamI]
        in
            createDec(rtnType, fnName, params,stmts)
        end
 
        (*-------------- Dec functions from Store ---------------*)
    (* storeAligned:CL.ty* Var*Var*Var->CL.S
    * Aligned store vec body
    * (vec2f_t )&(A[4])=v;
    *   storeVec Aligned
    *)
    fun storeAligned ty= let
        val e=   CL.E_Subscript(VarA,VarI)
        val lhs= CL.E_Ref(ty, e)
        in
        [CL.S_Eq (lhs ,VarV)]
        end

    (* store:int*int*Var*Var*Var->CL.S
    * not aligned store Vec body
    *)
     fun store(tyN,tyI)= let
        val (stmt, VarUR)= mkExtVar(tyN, varU,VarV)
        val rhs= indexDiderotType(VarUR,tyI)
        val lhs=indexDiderotTypeWithOffset(VarA, tyI, VarI)
        val e=setEq(lhs,rhs)
        in
            [stmt]@e
        end
     
     (* store1:int*Var*Var Var->CL.S
     *Store real number
     *)
     fun store1 tyN= let
        val lhs=indexDiderotTypeWithOffset(VarA, tyN, VarI)
        in
            setEq(lhs,[VarV])
        end
     
     (*storeVec:bool*int*int->CL.D_Func
     *General store function
     *)
     fun storeVec(aligned,tyOrig,tyN)= let
        val rtnType = voidTy
        val fnName = N.NameStoreVec(aligned,tyN,tyOrig)
        val params = [ParamA,ParamI,ParamV tyN]
        val stmts = (case (tyOrig,tyN>tyOrig,aligned)
            of  (1,_,_)         => store1 tyN
            (*| (_,false,true)  => storeAligned tyN*)
            |  (_,false, _ )    => store(tyN,tyN)
            |  (_,true, _ )     => store(tyN,tyOrig)
            (*end case*))
        in
            createDec(rtnType, fnName, params,stmts@[voidRtn])
        end
     
    (* handleOpr: TreeIl.Opr->CL.D_Func
    *  transform Tree-IL Opr to CLang Declarations
    *)
    fun handleOpr fnc=(case fnc
      of ILF.LDArr (A,1,_)              => default
      | ILF.LDArr (A,tyR,tyO)           => generalldVec(A,tyR,tyO)
      | ILF.STORE (A,tyO,tyNOp)         => storeVec(A,tyO,tyNOp)
      | ILF.CONSV 1                     => default
      | ILF.CONSV n                     => realToVec n
      | ILF.CONS n                      => realToArr n
      | ILF.COPY 1                      => default
      | ILF.COPY n                      => mkCopy n
      | ILF.OP(Op.prodScaV 1)           => default
      | ILF.OP(Op.prodScaV d)           => mkScaV d
      | ILF.OP(Op.sumVec([1],_))          => default
      | ILF.OP(Op.sumVec(nSize,oSize))  => mkSumV(nSize,oSize)
      | ILF.OP(Op.Floor 1)              => default
      | ILF.OP(Op.Floor d)              => mkFloorV d
      | ILF.OP(Op.clampVec 1)           =>default
      | ILF.OP(Op.clampVec d)           =>mkClampV d
      | ILF.OP(Op.lerpVec 1)            =>default
      | ILF.OP(Op.lerpVec d)            =>mkLerpV d
      | ILF.OP(Op.Zero(Ty.TensorTy ty)) => mkZeroOp ty
      | ILF.OP e                        => raise Fail("OPR of Op:"^Op.toString(e))
    (*end case*))

end

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