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 2663 - (download) (annotate)
Fri May 30 18:02:41 2014 UTC (5 years, 4 months ago) by cchiw
File size: 6290 byte(s)
added decl
(* Tree-IL Opr expression to Clang *)

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

    (*-------------- Function Names:String ---------------*)
    fun NameRealToVec d=N.mkVec d
    fun NameScaV d= N.scale d
    fun NameLdVec(tyN,tyO)= String.concat["ldVec",q tyO,"to",q tyN]
    fun NameMkVec d= String.concat["concatVec" ,q d]

    (*-------------- Types ---------------*)
    val realTy=CL.T_Named(N.mkReal)


    (*-------------- var:strings ---------------*)
    val varS="s"
    val varV="v"
    val tmp= "a"
    fun mkInt i =CL.mkInt(IntInf.fromInt i)
    (*mkVars: int -> var list *)
    fun mkVar 0=[]
      | mkVar n= mkVar(n-1)@ [String.concat[tmp,q n ]]

    (*-------------- E_VAR:exp ---------------*)
    fun varToVars e=List.map (fn e1=>CL.E_Var e1) e


    (*-------------- Params ---------------*)
    (* mkParams:creates Params
    * (attr list, ty, var)-> Param List
    *)
    fun mkParams e=List.map (fn e1=> CL.PARAM e1) e


    (* mkParamsSameType:Create params with the same type
     *    ty:CLangty, args: vars -> Param list 
     *)
    fun mkParamsSameType(ty,args)=List.map (fn e=>CL.PARAM([],ty,e)) args


    (*-------------- Exp functions ---------------*)
    (*mkCast:Create a cast expression
     *ClangTy, exp list -> exp
     *)
    fun mkCast(ty,body)=CL.E_Cast(ty, (CL.E_Struct body))


    (* mkProd:create a Product Operation
      exp *exp ->  exp 
    *)
    fun mkProd(a,b)=CL.mkBinOp(a, CL.#*, b)
    fun mkAdd(a,b)= CL.mkBinOp(a, CL.#+, b)
  
    


    (*Should I use Subscript and E_Int?*)
    fun indexDiderotType(U,0)=[CL.E_Subscript(U,mkInt  0)]
      | indexDiderotType(U,n)=
        indexDiderotType(U,n-1)@[CL.E_Subscript(U,mkInt  n)]
 
    fun indexDiderotTypeWithOffset(U,0,var)=
        [CL.E_Subscript(U,mkAdd(mkInt 0,var))]
      | indexDiderotTypeWithOffset(U,n,var)=
        indexDiderotTypeWithOffset(U,n-1,var)@
        [CL.E_Subscript(U,mkAdd(mkInt n,var))]
 


    (*mkZero: mk List of 0 expressions
     * int -> exp
     *)
    fun mkZero n=let
        val z=mkInt 0
        in
            List.tabulate (n,fn _=> z)
        end 

    (*-------------- Dec functions ---------------*)

    (* createDec(): create a CLang Decl
     * Ty,string, exp list, exp list -> Declaration
    *)
    fun createDec(rtnType, fnName, params,blk)= let
        val stmt'=CL.S_Block blk
        in
            CL.D_Func([],rtnType,fnName,params,stmt')
        end


    (*Tree-IL Opr-> Cl.decl *)
    fun mkRealToVec d=let        
       
        val rtnType= CL.T_Named(N.vecTy d)
        val fnName=NameRealToVec d
        val vars=mkVar d
        val params=mkParamsSameType(realTy, vars)

        (*Return Expression *)
        val VARS=varToVars vars
        val body=SOME (mkCast(rtnType,VARS))
        val rtn=CL.S_Return body
        in
            createDec(rtnType, fnName, params,[rtn])
        end 

    fun mkScaV d= let
        val rtnType= CL.T_Named(N.vecTy d)
        val fnName=NameScaV d
        val params=mkParams[([],realTy,varS),([],rtnType,varV)]

        (*Return Expression *)
        val varList=List.tabulate(d, (fn _=>CL.E_Var varS))
        val fnCall=NameRealToVec d
        val s=CL.E_Apply(fnCall, varList)
        val v=CL.E_Var varV
        val body=SOME(mkProd(s,v))
        val rtn=CL.S_Return body
        in
            createDec(rtnType, fnName, params,[rtn])
        end


   fun fillVec(tyNew,tyOrig)=let
        val indexedVec=indexDiderotType(CL.E_Var varV,tyOrig-1)
        val fill=mkZero(tyNew-tyOrig)
        in
            indexedVec@fill
        end


    fun sliceVec tyNew= 
            indexDiderotTypeWithOffset(CL.E_Var varV,tyNew-1,CL.E_Var varS)
 
    fun ldVec(tyNew,tyOrig) =  let
        val rtnType= CL.T_Named(N.vecTy tyNew)
        val fnName=NameLdVec(tyNew,tyOrig)
        val argType= CL.T_Named(N.vecTy tyOrig)
        val params=mkParams[([],argType,varV),([],realTy, varS)]
 
 
        val pieces= (if (tyNew>tyOrig)
            then fillVec(tyNew, tyOrig)
            else sliceVec tyNew
            (*end case*))
        val body=SOME(mkCast(rtnType,pieces))
        val rtn=CL.S_Return body
        in
             createDec(rtnType, fnName, params,[rtn])
        end
 
 

    fun mkVec(tyOrig,Ty.vectorLength pieces)= let
        val rtnType= CL.T_Named(N.vecTy tyOrig)
        val fnName=NameMkVec tyOrig
        val n =length(pieces)

        fun m(c,varList,rest,[])=(varList,rest)
          | m(c,varList,rest,e1::es)=let
            val var=varV^(q c)
            in
                m(c+1, varList@[CL.E_Var(var)],rest@[([],CL.T_Named(N.vecTy e1), var)], es)
            end
        val (VARList,rest)=m(0, [],[],pieces)
        val params= mkParams rest

        fun sort(0,[], [],rest)= rest 
          | sort(0,_,_,rest) =raise Fail "Too Many vectors for mkVec"
          | sort(rtnN,[var], [p],rest)=let
            val indexedVec= indexDiderotType(var,rtnN-1)
            in
                rest@indexedVec
            end

          |sort(rtnN, var::es,p::pieces,rest)=let
            val indexedVec= indexDiderotType(var,p-1)
            in
              sort(rtnN-p,es,pieces,rest@indexedVec)
            end


        val e=sort(tyOrig, VARList, pieces, [])

        val body=SOME(mkCast(rtnType,e))
        val rtn=CL.S_Return body
        in
            createDec(rtnType, fnName, params,[rtn])
        end



    val default=CL.D_NotDone

    (* handleOPr: transform Tree-IL Opr to CLang Declarations*)
    fun handleOpr( ILF.LD (tyNew,tyOrig))=ldVec(tyNew,tyOrig)
      | handleOpr( ILF.MKVEC (tyOrig,pieces))=mkVec(tyOrig,pieces)
      | handleOpr( ILF.CONS a0)= default
      | handleOpr( ILF.REALTOVEC d)=mkRealToVec d
      | handleOpr( ILF.OP(Op.prodScaV d))=mkScaV d
      | handleOpr( ILF.OP(Op.IndexTensor(a,RTy,b,c)))=default
      | handleOpr( ILF.OP(Op.addVec _))=default
      | handleOpr( ILF.OP(Op.subVec _))=default
      | handleOpr( ILF.OP(Op.prodVec _))=default
      | handleOpr( ILF.OP e)= raise Fail("OPr of Op:"^Op.toString(e))
      | handleOpr( ILF.LDAligned (tyNew,tyOrig))=default
      | handleOpr( ILF.MKVECAligned (tyOrig,pieces))=default


end

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