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 2668 - (download) (annotate)
Thu Jun 12 03:29:04 2014 UTC (5 years, 2 months ago) by cchiw
File size: 8587 byte(s)
Change global types to arrays and print them
(* WQE 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)
    val star=CL.T_Ptr realTy
    fun vecTy d= CL.T_Named(N.OvecTy d)
    val intTy = CL.intTy
    fun unionTy d  = CL.T_Named(N.unionTy d)
    val voidTy=CL.voidTy
    fun mkRealArr n=  CL.mkRealArr(N.mkReal,n)

    (*-------------- var:strings ---------------*)

    val varR="r"   (*reals*)
    val varV="v"  (*vector*)
    val varI="i"  (*int*)
    val varA="a" (*float*)
    val varU="u" (*unionTy*)
    val tmp="b" (*unused*)

    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
    fun varToVar e =CL.E_Var e

    (*-------------- Params ---------------*) 
    (*Params created from vars*)
    val ParamA=([], star,varA) (*float ptr * a *)
    val ParamI=([],intTy, varI)   (*Int i*)
    fun ParamV n =([],vecTy n, varV) (*vector v*)
    val ParamR= ([],realTy,varR)  (*Real R *)
 
 
    (* mkParams:creates Params
    * (attr list, ty, var)-> Param List
    *)
    fun mkParam e= CL.PARAM e
    fun mkParams e=List.map (fn e1=> mkParam 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 ---------------*)
 
    fun mkRtn e=CL.S_Return(SOME e)
    val  voidRtn =CL.S_Return NONE
    (*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, body)


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

    (* 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,I)=
        [CL.E_Subscript(U,I)]
      | indexDiderotTypeWithOffset(U,n,I)=
        indexDiderotTypeWithOffset(U,n-1,I)@
        [CL.E_Subscript(U,mkAdd(mkInt n,I))]
 


    (*mkZero: mk List of 0 expressions
     * int -> exp
     *)
    fun mkZero n=let
        val z=mkInt 0
        in
            List.tabulate (n,fn _=> z)
        end
 
 
    fun setEq([],[])=[]
      | setEq (l::lhs, r::rhs)=[CL.S_Eq (l ,r)]@ setEq(lhs,rhs)

    (*-------------- Dec functions from Ops ---------------*)

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

 
 (*Intermediate Statement from reals -> RealArray*)
 fun IntermediateCons(d,VARS) =let
    val ty=mkRealArr [d]
    val tmpVar=CL.E_TyVar(ty,varA)
    val stmt=CL.S_Eq(tmpVar,CL.E_Struct VARS)
    in (varA, stmt)
    end
 

 fun mkScaV d= let
    val rtnType= vecTy d
    val fnName=N.NameScaV d
    val params=mkParams[ParamR,([],rtnType,varV)]
    (*Return Expression *)
    val varList=List.tabulate(d, (fn _=>CL.E_Var varR))
    val fnCall=N.NameConsVec d
    val s=CL.E_Apply(fnCall, varList)
    val VarV=varToVar varV
    val rtn=mkRtn(mkProd(s,VarV))
    in
        createDec(rtnType, fnName, params,[rtn])
    end

    fun mkSumV d= let
        val rtnType= realTy
        val fnName=N.NameSumV d
        val params=mkParams[ParamV d]
        val VarV=varToVar varV
        val (e,VarUR)=mkExtVar(d, varU,VarV)

        (*Return Expression *)
        val indexedVec=indexDiderotType(VarUR,d-1)
        val rtn=mkRtn(mkAddM indexedVec)
        in
            createDec(rtnType, fnName, params,[e,rtn])
        end



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

 
    fun mkRealToArr d=let
        val rtnType= voidTy
        val fnName=N.NameConsArray d
        val vars=mkVar d
        val Vars=varToVars vars
        val params=[mkParam ParamA]@ mkParamsSameType(realTy, vars)
        val VarA= CL.E_Var varA
 
        val lhs=indexDiderotType(VarA, d-1)
        val stmts=setEq(lhs,Vars)
        in
            createDec(rtnType, fnName, params,stmts@[voidRtn])
        end


    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 rtn= mkRtn(CL.E_Ext(body'))
    in
        createDec(rtnType, fnName, params,[rtn])
    end
 
 
        (*-------------- Dec functions from LDVec ---------------*)
    (*Does Load when not aligned*)
    (* val (e,VarUR)=mkExtVar(tyOrig, varU,VarA)*)
     fun ldVec(tyNew,tyOrig,rtnType,VarA,VarI) =let
        fun fillVec var=let
            val indexedVec=indexDiderotTypeWithOffset(var,tyOrig-1,VarI)
            val fill=mkZero(tyNew-tyOrig)
            in
                indexedVec@fill
            end
        fun sliceVec var= indexDiderotTypeWithOffset(var,tyNew-1,VarI)
        val pieces= (if (tyNew>tyOrig)
            then fillVec VarA
            else sliceVec VarA
            (*end case*))
    in
        [mkRtn (mkCastStruct(rtnType,pieces))]
    end
 
 

 
    (*General Load*)
    fun generalldVec(A,tyNew,tyOrig) =let
        val VarA= CL.E_Var varA
        val VarI=CL.E_Var varI
        val rtnType= vecTy tyNew
        val fnName=N.NameLdVec(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=mkParams[ParamA,ParamI]
    in
        createDec(rtnType, fnName, params,stmts)
    end
 
 

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

(* Aligned store vec body
 * (vec2f_t )&(A[4])=v;
 *)
    fun mkVec0(tyR, ty,VarA,VarI,VarV)= let
        val e=   CL.E_Subscript(VarA,VarI)
        val lhs= CL.E_Ref(ty, e)
    in
       [CL.S_Eq (lhs ,VarV)]
    end


 (*not aligned store Vec body *)
 fun mkVec1(tyN,tyO, VarA,VarI,VarV)= let
    val (stmt, VarUR)= mkExtVar(tyN, varU,VarV)
    val rhs= indexDiderotType(VarUR,tyO-1)
    val lhs=indexDiderotTypeWithOffset(VarA, tyO-1, VarI)
    val e=setEq(lhs,rhs)
 
    in
        [stmt]@e
    end
 
 
 (*General store function *)
 fun generalmkVec(aligned,tyN,tyOrig)= let
    val rtnType=voidTy
    val fnName=N.NameMkVec(aligned,tyN,tyOrig)
    val VarA= CL.E_Var varA
    val VarI=CL.E_Var varI
    val VarV= CL.E_Var varV
    val ty=vecTy tyN
    val params=mkParams [ParamA,ParamI,([],ty, varV)]
    val stmts=(case aligned
        of false => mkVec1(tyN,tyOrig,VarA,VarI,VarV)
        | true =>   mkVec0(tyN, ty, VarA,VarI,VarV)
        (*end case*))

    in
        createDec(rtnType, fnName, params,stmts@[ voidRtn])
    end 
 
 
    val default=CL.D_NotDone

    (* handleOPr: transform Tree-IL Opr to CLang Declarations*)
    fun handleOpr( ILF.LD (b,tyNew,tyOrig))= generalldVec(b,tyNew,tyOrig)
      | handleOpr( ILF.MKVEC (A,tyR,tyO))=
            generalmkVec(A,tyR,tyO)
      | handleOpr( ILF.CONSV n)= mkRealToVec n
      | handleOpr( ILF.CONS(Ty.TensorTy[n]))=mkRealToArr 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.Floor 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))
    



end

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