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/gen-kernel.sml
ViewVC logotype

View of /branches/charisee/src/compiler/mid-to-low/gen-kernel.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2533 - (download) (annotate)
Thu Jan 30 04:58:56 2014 UTC (5 years, 5 months ago) by cchiw
File size: 7308 byte(s)
type checker
(*hashs Ein Function after substitution*)
structure genKrn = struct
    local
    structure E = Ein
   structure DstOp = LowOps
    structure genHelper=genHelper
    structure evalKrn =evalKrn
structure SrcIL = MidIL
structure SrcOp = MidOps
structure SrcSV = SrcIL.StateVar
structure SrcTy = MidILTypes
structure VTbl = SrcIL.Var.Tbl
structure DstIL = LowIL
structure DstTy = LowILTypes
 structure Var = LowIL.Var
    in



(*Add,Subtract Scalars*)
fun mkSimpleOp(mapp,e,args)=let

    fun subP e=(case e
        of E.Tensor(t1,ix1)=>genHelper.mkSca(mapp,(t1,ix1,args))
        | E.Value v1=> genHelper.aaV(DstOp.C (List.nth(mapp,v1)),[],"Const",DstTy.TensorTy([]))
        | E.Const c=> genHelper.aaV(DstOp.C 9,[],"Const",DstTy.TensorTy([]))
    (*end case*))

    in (case e
        of E.Sub(e1,e2)=> let
            val (vA,A)=subP e1
            val (vB,B)=subP e2
            val (vD,D)=genHelper.aaV(DstOp.subSca,[vA,vB],"Subsca",DstTy.TensorTy([]))
            in (vD,A@B@D) end
        | E.Add[e1,e2]=> let
            val (vA,A)=subP e1
            val (vB,B)=subP e2
            val (vD,D)=genHelper.aaV(DstOp.addSca, [vA,vB],"addsca",DstTy.TensorTy([]))
            in (vD,A@B@D) end
        (* ebd case*))
    end


(*FIX TYPE ON CONS TYPE HERE *)
(*con everything on the list, make a vectors*)
fun consfn([],rest, code,dim,n)=(rest,code)
    | consfn(e::es,rest,code,dim,n)=let
        val gg=length(e)
        val (vA,A)=genHelper.aaV(DstOp.cons(DstTy.TensorTy [gg],0),List.rev e,"Cons "^Int.toString(n)^":--",DstTy.TensorTy([gg]))
        in consfn(es, [vA]@rest, A@code,dim,n+1)
        end


(*sort expression into kernels and images*)
fun sortK(a,b,[])=(a,b)
| sortK(a,b,e::es)=(case e
    of E.Krn k1=>sortK(a,b@[k1],es)
    | E.Img img1=>sortK(a@[img1],b,es)
    (*end case*))



fun printgetRHS x  = (case SrcIL.Var.binding x
    of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Kernel(h, _),_))=> h
    | vb => (raise Fail (String.concat["\n -- ", SrcIL.Var.toString x,"but found ", SrcIL.vbToString vb,"\n"]))
(* end case *))


val bV= ref 0




fun sumP(a,b,last)=let
    val (vD, D)=genHelper.aaV(DstOp.prodVec(last),[a, b],"prodV",DstTy.TensorTy([last]))
    val (vE, E)=genHelper.aaV(DstOp.sumVec(last),[vD],"sumVec",DstTy.intTy)
    in (vE,D@E) end

fun ccons(rest,shape)= let
    val(vE,E)=genHelper.aaV(DstOp.cons(DstTy.TensorTy shape,0),rest,"Cons",DstTy.TensorTy(shape))
    in (vE,E) end
fun printMap ix=String.concat(List.map (fn e1=>Int.toString(e1)) ix)


(*Images*)
fun mkImg(mappOrig,sx,[(fid,ix,px)],v,args)=let

    val ll=print("\n\n\n image \n\n")
    val (_,lb,ub)=hd(sx)
    val top=ub-lb
    val R=top+1
    val dim=length(px)
    val sx'=List.tabulate(dim, fn _ =>top)
    val sx''=List.map (fn n=>n+1) sx'
    val argType=DstTy.tensorTy (List.tabulate(dim, fn _ =>R))


    fun  createImgVar mapp=let
        fun mkpos([E.Add[E.Tensor(t1,ix1),_]],rest,code)= let
            val (vA,A)=genHelper.mkSca(mapp,(t1,ix1,args))
        
            in
                (rest@[vA],code@A)
            end

        | mkpos(pos1::es,rest,code)= let
            val (vF,code1)=mkSimpleOp(mapp,pos1,args)
            in mkpos(es,rest@[vF],code@code1)
            end
        val ix1=List.map (fn (e1)=> genHelper.mapIndex(e1,mapp)) ix
        val (vF,F)= mkpos(px,[],[])     
        val imgType=DstTy.imgIndex ix1
        val (vA,A)=genHelper.aaV(DstOp.imgAddr(v,imgType,dim),vF,"Imageaddress",DstTy.intTy)
        val (vB,B)=genHelper.aaV(DstOp.imgLoad(v,dim,R),[vA],"imgLoad"^(printMap mapp)^"---",DstTy.tensorTy([R]))
        in
            (vB,F@A@B)
        end


    fun sumI1(lft,ix,0,0,code)=let
            val mapp=mappOrig@ix@[lb]
            val (lft', code')= createImgVar mapp
            in ([lft']@lft,code'@code)
            end
    |  sumI1(lft,ix,i,0,code)=let
        val mapp=mappOrig@ix@[i]
        val (lft', code')=createImgVar mapp
        in sumI1([lft']@lft,ix,i-1,0,code'@code)
        end
    | sumI1(lft,ix,0,n,code)=
        sumI1(lft,ix@[lb],top,n-1,code)
    | sumI1(lft,ix,i,n, code)=let
        val (lft',code')=sumI1(lft,ix@[i+lb],top,n-1,code)
        in sumI1(lft',ix,i-1,n,code') end
        
    val(lft,code)=sumI1([],[],top,dim-2,[])
    val g=print ("Number of Assignments returned"^Int.toString(length(lft)))
    in
        (lft,code)

    end


(* kernels*)
fun  mkkrns(a,sx,k1,h,args)=let
    val ll=print("\n\n\n Kernel code \n ")

    val k= List.map (fn (id,d1,pos)=>(id,genHelper.evalDelta(d1,a),pos)) k1
    val tester=print "Differentiaiton value of kernels:"
    val uu=List.map (fn(id,v, pos)=> print(Int.toString(v)))  k

    val (_,lb,ub)=hd(sx)
    val R=(ub-lb)

    fun mm(e)=Int.toString e
    val qq=print(String.concat["\n ub:", mm ub, "lb:", mm lb, "Range", mm R ])

    fun q([],fin,l,ix, i,code)=(fin,code)
        | q((id1,d,pos1)::ks,fin,l,ix,0,code)=let
            val mapp=a@ix@[lb]
            val (l', code')=mkSimpleOp(mapp,pos1,args)
            val e=l@[l']
            in  q(ks,fin@[e],[],ix@[0],R,code@code')
            end
        | q(k::ks,fin,l,ix, i,code)=let
            val (id1,d,pos1)=k
            val mapp=a@ix@[lb+i]
            val (l', code')=mkSimpleOp(mapp,pos1,args)
            in  q(k::ks,fin,l@[l'],ix,i-1,code@code')
            end

 
    val(lftkrn,code)=q(k,[],[],[],R,[])
    val (lft,code')=consfn((lftkrn),[],[],R,0)
    in
        (lft,code@code')
    end
 
(*Written for 2-d and 3-d*)
fun prodImgKrn(imgArg,krnArg,R)=let
    val ll=print("\n\n prod Img Krn Code \n")

    val tyM=DstTy.TensorTy[R,R]
    val tyV=DstTy.TensorTy[R]
        val g=print ("Number of Assignments  in prodImgArg returned"^Int.toString(length(imgArg)))

    fun dhz([],conslist,rest,code,_,_)=(conslist,code)
    | dhz(e::es,conslist,rest,code,hz,0)=let
        val (vA,A)=sumP(e,hz,R)
        val (vD,D)=genHelper.aaV(DstOp.cons(DstTy.intTy,R),rest@[vA],"Cons",tyV)
        in dhz(es,conslist@[vD],[],code@A@D,hz,R-1)
        end
    | dhz(e::es,conslist,rest,code,hz,r)=let
        val (vA,A)=sumP(e,hz,R)
        in dhz(es,conslist,rest@[vA],code@A,hz,r-1)
    end


    fun dhy([],rest,code,hy)=   let
             val n=length(rest)
            val (vD,D)=genHelper.aaV(DstOp.cons(DstTy.intTy,n),rest,"Cons",tyV)
            in
            (vD,code@D) end
        | dhy(e::es,rest,code,hy)=let
            val (vA,A)=sumP(e,hy,R)
            in dhy(es,rest@[vA],code@A,hy)
            end

    in (case krnArg
        of [hy,hx]=>let 
            val ty=DstTy.TensorTy[R]
            val (vD,code)=dhy(imgArg,[],[],hy)
            val (vE,E)=sumP(vD,hx,R)
            in
                (vE,code@E)
            end
    |   [hz,hy,hx]=>let
 

        val (vZ,codeZ)=dhz(imgArg,[],[],[],hz,R-1)
        val (vY,codeY)=dhy(vZ,[],[],hy)
        val (vE,E)=sumP(vY,hx,R)
        in
            (vE,codeZ@codeY@E)
        end

    (*end case*))
    end 

fun  evalField(a,(E.Sum(sx,E.Prod e),v,h,args))=let
    val ar=print "\n\n ************** new direction **********\n\n Outer Bound:"
    val tester=print(printMap a)

    val (img1,k1)=sortK([],[],e)
    val (_,lb,ub)=hd(sx)
    val R=(ub-lb)+1

    val (imgArg,imgCode)= mkImg(a,sx,img1,v,args)
    val (krnArg, krnCode)= mkkrns(a,sx,k1,h,args)
    val (vA,A)=prodImgKrn(imgArg,krnArg,R)
    in  (vA,imgCode@krnCode@A)


    end



end (* local *)

end

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