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 2667 - (download) (annotate)
Thu Jun 5 18:54:12 2014 UTC (5 years, 2 months ago) by cchiw
File size: 12254 byte(s)
changed inlcude
(* 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


    (*-------------- Types ---------------*)
    val realTy=CL.T_Named(N.mkReal)
    fun vecTy d= CL.T_Named(N.vecTy d)
    val intTy = CL.intTy
    fun unionTy d  = CL.T_Named(N.unionTy d )
    val voidTy=CL.voidTy

    (*-------------- var:strings ---------------*)
    val varS="s"
    val varR="r"
    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 mkParam e= CL.PARAM e
    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


    (*list of vectors=>  (size, var, vec type)list * PARAMS list *)
    fun foundPieces pieces =let
        fun m(_,[],info,params)=(info,params)
        | m(c,e1::es,info,params)=let
            val var=varV^(q c)
            val ty=vecTy e1
            val p1=mkParam([],ty, var)
            val i=(e1, ty,CL.E_Var var)
            in
                m(c+1,es, info@[i], params@[p1] )
            end
        in m(0,pieces,[],[]) end



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



    (*ty:vectTy n  varU = (ty) varA*)
    fun mkExtVar(n, varU,varA)=let
        val uty=unionTy n
        val exp=mkCastVar(uty, varA)
        val e1=CL.E_TyVar(uty,varU)
        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,varU^".r")
        end

    fun mkExtStruct(n, varU,varA)=let
        val uty=unionTy n
        val exp=mkCastStruct(uty, varA)
        val e1= CL.E_TyVar(uty,varU)
        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,varU^".r")
        end
 


    (* 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)
    fun mkAddM [a]=a
    | mkAddM (a::b::es)= mkAddM (CL.mkBinOp(a, CL.#+, b)::es)




    (*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 from Ops ---------------*)

    (* 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


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

        (*Return Expression *)
        val varList=List.tabulate(d, (fn _=>CL.E_Var varR))
        val fnCall=N.mkVec d (*N.NameConsVec 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 mkSumV d= let
        val rtnType= realTy
        val fnName=N.NameSumV d
        val params=mkParamsSameType(vecTy d, [varV])

        val (e,ur)=mkExtVar(d, "u",varV)

        (*Return Expression *)
        val indexedVec=indexDiderotType(CL.E_Var ur,d-1)
        val body=(mkAddM indexedVec)
        val rtn=CL.S_Return(SOME body)
        in
            createDec(rtnType, fnName, params,[e,rtn])
        end



        (*-------------- Dec functions from CONS ---------------*)

    fun mkRealToVec d=let

        val rtnType= vecTy d
        val fnName=N.NameConsVec d
        val vars=mkVar d
        val params=mkParamsSameType(realTy, vars)

        (*Return Expression *)
        val VARS=varToVars vars
        val body'= mkCastStruct(rtnType,VARS)
        val body= SOME(CL.E_Ext(body'))
        val rtn=CL.S_Return body
        in
            createDec(rtnType, fnName, params,[rtn])
        end
 
    fun mkRealToVec2 d=let
 
        val rtnType= vecTy d
        val fnName=N.NameConsVec d
        val vars=mkVar d
        val params=mkParamsSameType(realTy, vars)

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


        (*-------------- Dec functions from LDVec ---------------*)
    (*addr,offset(int)*)
 
     fun generalLdVec(tyNew,tyOrig,fnName) =let
        val VarV=CL.E_Var varV
        val VarS=CL.E_Var varS

        fun fillVec(tyNew,tyOrig,var)=let
            val indexedVec=indexDiderotType(var,tyOrig-1)
            val fill=mkZero(tyNew-tyOrig)
            in
                indexedVec@fill
            end
        fun sliceVec(tyNew,var)=
            indexDiderotTypeWithOffset(var,tyNew-1,VarS)

        val rtnType= vecTy tyNew
        val params=mkParams[([],vecTy tyOrig,varV),([],intTy, varS)]

  
        val (e,ur)=mkExtVar(tyOrig, "u",varV)
        val VarUR=CL.E_Var ur

        val pieces= (if (tyNew>tyOrig)
            then fillVec(tyNew, tyOrig,VarUR)
            else sliceVec(tyNew,VarUR)
            (*end case*))
        val body=SOME(mkCastStruct(rtnType,pieces))
        val rtn=CL.S_Return body
        in
             createDec(rtnType, fnName, params,[e,rtn])
        end
 
    (*ldVec aligned or not use the same function for now*)
 
    fun ldVec(tyNew,tyOrig) =let
        val fnName=N.NameLdVec(tyNew,tyOrig)
    in
            generalLdVec(tyNew,tyOrig,fnName)
    end
 
    fun ldVecA(tyNew,tyOrig) =let
        val fnName=N.NameLdVecA(tyNew,tyOrig)
    in
            generalLdVec(tyNew,tyOrig,fnName)
    end
 
 

        (*-------------- Dec functions from mKVec ---------------*)



    (*   (vec2f_t )&(v[4])=b;*)
    fun mkVec0(tyOrig, pieces)= let
        val rtnType=voidTy
        val fnName=N.NameMkVecA tyOrig
        val varU="U"
        val VarU= CL.E_Var varU
 
        val p1=mkParams[([], realTy,String.concat[varU,"[",q tyOrig,"]"])]
        val (info, param)=foundPieces pieces
        val params=p1@param
        fun sort(0,_,[],rest)= rest
        | sort(0,_,_,rest) =raise Fail "Too Many vectors for mkVec"
        | sort(rtnN,indexAt,[(p, ty,var)],rest)=let
            val e= CL.E_Subscript(VarU,mkInt  indexAt)
            val lhs= CL.E_Ref(ty, e)
            in rest@[CL.S_Eq (lhs ,var)] end
        | sort(rtnN,indexAt, (p, ty,var)::es,rest)=let
            val e= CL.E_Subscript(VarU,mkInt  indexAt)
            val lhs= CL.E_Ref(ty, e)
            val e2=[CL.S_Eq (lhs ,var)]
            in
                sort(rtnN-p,indexAt+p,es,rest@e2)
            end

        val stmts=sort(tyOrig,0, info, [])
        val rtn=CL.S_Return NONE
    in
        createDec(rtnType, fnName, params,stmts@[rtn])
    end


    (*Helpers*)
 (*use extensions*)
    fun peelA([],stmts,newInfo)= (stmts,newInfo)
    |  peelA((p,ty,CL.E_Var var)::es, stmts, newInfo) = let
        val (e, ur)= mkExtVar(p, var^"_u",var)
        in peelA(es, stmts@[e], newInfo@[(p, ty, CL.E_Var ur)])
        end
 
 fun sortA(0,[],rest)= rest
   | sortA(0,_,rest) =raise Fail "Too Many vectors for mkVec"
   | sortA(rtnN,[(p, ty,var)],rest)=let
        val indexedVec= indexDiderotType(var,rtnN-1)
        in
            rest@indexedVec
        end
   | sortA(rtnN,(p, ty,var)::es,rest)=let
        val indexedVec= indexDiderotType(var,p-1)
        in
            sortA(rtnN-p,es,rest@indexedVec)
        end
 fun mA(_,lhsvar,[],rest)=rest
   | mA (n,lhsvar, rhs::es,rest)=let
        val lhs= CL.E_Subscript(lhsvar,mkInt n)
        val e2=[CL.S_Eq (lhs ,rhs)]
        in mA (n+1, lhsvar,es, rest@e2)
        end
 
    (*Tries to use union on rtn variable, but then what do we return?*)
    fun mkVecDoubleExt(tyOrig, pieces)= let
        val rtnType=voidTy
        val fnName=N.NameMkVecA tyOrig
        val varU="U"
        val varZ="Z"
        val VarZ= CL.E_Var varZ
        val ty=vecTy tyOrig
        val p1=mkParams[([],ty,varZ)]
        val (info, param)=foundPieces pieces
        val (e1, varur)= mkExtVar(tyOrig, varU,varZ)
        val VarU= CL.E_Var varur
        val params=p1@param  
        val (stmts, info)=peelA(info, [],[])
        val e=sortA(tyOrig, info, [])
        val e=mA(0,VarU,e,[])
        val e2=CL.S_Eq (VarZ, CL.E_Select(CL.E_Var "U","v"))
        val rtn=CL.S_Return NONE
 
 
        in
          createDec(rtnType, fnName, params,[e1]@stmts@e@[e2,rtn])
            
        end
 
 (*Send back vectype by a cast
  * none ->vecTy
  *)

 fun mkVec3(tyOrig, pieces)= let
    val rtnType=voidTy
    val fnName=N.NameMkVecA tyOrig
    val varU="U"
    val VarU= CL.E_Var varU
    val ty=vecTy tyOrig 
    val (info, params)=foundPieces pieces 
    val (stmts, info)=peelA(info, [],[])
    val e=sortA(tyOrig, info, [])
    val ecast= mkCastStruct(ty,e)
    val rtn=CL.S_Return(SOME ecast)
    in
        createDec(ty, fnName, params,stmts@[rtn])
    end
 
 
 
 (*realty-> void *)
 fun mkVec1(tyOrig, pieces)= let
    val rtnType=voidTy
    val fnName=N.NameMkVec tyOrig
    val varU="U"
    val VarU= CL.E_Var varU
    val p1=mkParams[([], realTy,String.concat[varU,"[",q tyOrig,"]"])]
    val (info, param)=foundPieces pieces
    val params=p1@param
    val (stmts, info)=peelA(info, [],[])
    val e=sortA(tyOrig, info, [])
    val e=mA(0,VarU,e,[])
    val rtn=CL.S_Return NONE
    in
        createDec(rtnType, fnName, params,stmts@e@[rtn])
    end
 

    fun handleVec(tyOrig,pieces)=let
        val Attempt=3
       (*First 3 use MK(var,exp) statment and the last one is an assignment *)
        in (case Attempt
          of 0=>   (* realTy-> void   (vec2f_t )&(v[4])=b;*)
                mkVec0(tyOrig, pieces)
          | 1    =>(*realTY-> void, does union indexes elements U[0]=..*)
                mkVec1(tyOrig, pieces)
          | 2=>    (*vecTy-> void, uses union, gets warnings *)
                mkVecDoubleExt(tyOrig, pieces)
 
          | 3=> (* void->vecTy  uses a cast*)
            mkVec3(tyOrig, pieces)
        (*end case*))
        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,Ty.vectorLength pieces))=handleVec(tyOrig,pieces)
      | handleOpr (ILF.MKVEC _)= raise Fail "Unsupported mkVec type"
      | handleOpr( ILF.CONS(Ty.TensorTy[n]))= mkRealToVec n
      | handleOpr( ILF.CONS _)=  default
      | handleOpr( ILF.OP(Op.prodScaV d))=mkScaV d
      | handleOpr( ILF.OP(Op.sumVec d))=mkSumV 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))=ldVecA(tyNew,tyOrig)
      | handleOpr( ILF.MKVECAligned (tyOrig,Ty.vectorLength  pieces))=handleVec(tyOrig,pieces)



end

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