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

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/mid-to-low/gen-kernel.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2523 - (view) (download)

1 : cchiw 2522 (*hashs Ein Function after substitution*)
2 :     structure genKrn = struct
3 :     local
4 :     structure E = Ein
5 :     structure DstOp = LowOps
6 :     structure genHelper=genHelper
7 :     structure evalKrn =evalKrn
8 :     structure SrcIL = MidIL
9 :     structure SrcOp = MidOps
10 :     structure SrcSV = SrcIL.StateVar
11 :     structure SrcTy = MidILTypes
12 :     structure VTbl = SrcIL.Var.Tbl
13 :     structure DstIL = LowIL
14 :     structure DstTy = LowILTypes
15 :    
16 :     in
17 :    
18 :    
19 :    
20 :    
21 :    
22 :    
23 :     (*Add,Subtract Scalars*)
24 :     fun mkSimpleOp(mapp,e,args)=let
25 :    
26 :     fun subP e=(case e
27 :     of E.Tensor(t1,ix1)=>genHelper.mkSca(mapp,(t1,ix1,args))
28 :     | E.Value v1=> genHelper.aaV(DstOp.C (List.nth(mapp,v1)),[])
29 :     | E.Const c=> genHelper.aaV(DstOp.C 9,[])
30 :     (*end case*))
31 :    
32 :     in (case e
33 :     of E.Sub(e1,e2)=> let
34 :     val (vA,A)=subP e1
35 :     val (vB,B)=subP e2
36 :     val (vD,D)=genHelper.aaV(DstOp.subSca,[vA,vB])
37 :     in (vD,A@B@D) end
38 :     | E.Add[e1,e2]=> let
39 :     val (vA,A)=subP e1
40 :     val (vB,B)=subP e2
41 :     val (vD,D)=genHelper.aaV(DstOp.addSca, [vA,vB])
42 :     in (vD,A@B@D) end
43 :     (* ebd case*))
44 :     end
45 :    
46 :    
47 :     (*con everything on the list, make a vectors*)
48 :     fun peanut([],rest, code)=(rest,code)
49 :     | peanut(e::es,rest,code)=let
50 : cchiw 2523 val (vA,A)=genHelper.aaV(DstOp.cons(DstTy.einTy []),e)
51 : cchiw 2522 in peanut(es, [vA]@rest, A@code)
52 :     end
53 :    
54 :    
55 :     (*sort expression into kernels and images*)
56 :     fun sortK(a,b,[])=(a,b)
57 :     | sortK(a,b,e::es)=(case e
58 :     of E.Krn k1=>sortK(a,b@[k1],es)
59 :     | E.Img img1=>sortK(a@[img1],b,es)
60 :     (*end case*))
61 :    
62 :    
63 :    
64 :     fun printgetRHS x = (case SrcIL.Var.binding x
65 :     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Kernel(h, _),_))=> h
66 :     | vb => (raise Fail (String.concat["\n -- ", SrcIL.Var.toString x,"but found ", SrcIL.vbToString vb,"\n"]))
67 :     (* end case *))
68 :    
69 :    
70 :    
71 :     (*product of images and kernels*)
72 :     (*creates vectors of like terms, so does vector products*)
73 :     fun mkkrns(a,(E.Prod e,sx,origargs,args))=let
74 :     val ar=print "in mkkrn"
75 :     val (img1,k1)=sortK([],[],e)
76 :     val ar=print "in A"
77 :     val k= List.map (fn (id,d1,pos)=>(id,genHelper.evalDelta(d1,a),pos)) k1
78 :     val ar=print "B"
79 :     val nk=length(k)
80 :     val g=Int.toString(length(img1))
81 :     val ar=print "C"
82 :     val gg=Int.toString(nk)
83 :     val ggss=Int.toString(length sx)
84 :     val u=print (String.concat["IMG",g, "KRNS", gg,"sumx",ggss])
85 :    
86 :     fun m([],lft,_,[],mapp,code)= ((lft,code))
87 :     | m([],lft,e::rht,(id1,dels1,pos1)::krns,mapp,code)=let
88 :    
89 :     val (vF,code1)=mkSimpleOp(mapp,pos1,args)
90 :    
91 :     val (vH,H)=genHelper.aaV(DstOp.krn(id1,dels1),[vF])
92 :    
93 :     val e'=[vH]@e
94 :    
95 :     in
96 :     m([],lft@[e'], rht, krns,mapp, code1@H@code)
97 :     end
98 :     | m([(fid,ix,px)],[],e::rht,krns,mapp,code)=let
99 :    
100 :     fun mkpos([],rest,code)= (rest,code)
101 :     | mkpos(pos1::es,rest,code)= let
102 :     val (vF,code1)=mkSimpleOp(mapp,pos1,args)
103 :     in mkpos(es,rest@[vF],code@code1)
104 :     end
105 :    
106 :    
107 :     val ix1=List.map (fn (e1)=> genHelper.mapIndex(e1,mapp)) ix
108 :     val (vF,F)= mkpos(px,[],[])
109 : cchiw 2523 val (vA,A)=genHelper.aaV(DstOp.img(fid, DstTy.tensorTy ix1),vF)
110 : cchiw 2522 val e'=[vA]@e
111 :    
112 :    
113 :     in
114 :     m([],[e'],rht,krns,mapp,F@A@code)
115 :     end
116 :     | m _ =raise Fail "exceptooon"
117 :    
118 :     val uu=print "post m"
119 :    
120 :     fun sumI1(left,(0,lb1),[],emp,code)=let
121 :     val mapp=a@left@[lb1]
122 :     val (lft', code')=m(img1,[],emp,k,mapp,[])
123 :     in (lft',code'@code)
124 :     end
125 :     | sumI1(left,(i,lb1),[],emp,code)=let
126 :     val mapp=a@left@[i+lb1]
127 :     val (lft', code')=m(img1,[],emp,k,mapp,[])
128 :     in sumI1(left,(i-1,lb1),[],lft',code'@code)
129 :     end
130 :     | sumI1(left,(0,lb1),(a,lb2,ub)::sx,emp,code)=
131 :     sumI1(left@[lb1],(ub-lb2,lb2),sx,emp,code)
132 :     | sumI1(left,(s,lb1),(a,lb2,ub)::sx,emp,code)=let
133 :     val (lft',code')=sumI1(left@[s+lb1],(ub-lb2,lb2),sx,emp,code)
134 :     in sumI1(left,(s-1,lb1),(E.V 0,lb2,ub)::sx,lft',code') end
135 :    
136 :    
137 :    
138 :     val emp=List.tabulate(nk+1,(fn(e)=>[]))
139 :    
140 :     val (_,lb,ub)=hd(sx)
141 :    
142 :     val(lft,code)=sumI1([],(ub-lb,lb),tl(sx),emp,[])
143 :    
144 :     val (rest',code')=peanut(lft,[],[])
145 :     val d=length k
146 :     val (id,_,_)=hd(k)
147 :     val harg=List.nth(origargs,id)
148 :     val h=printgetRHS harg
149 :     fun evalK([],[],n)=[]
150 :     | evalK(kn::kns,x::xs,n)=let
151 :     val (_,dk,_) =kn
152 :     in evalKrn.expandEvalKernel (d, h, dk, x) @ evalK(kns,xs,n+1)
153 :     end
154 :     val mmm=evalK(k,tl(rest'),0)
155 :    
156 :    
157 :     val (vD,D)=genHelper.mkMultiple( rest',DstOp.prodVec)
158 :     val (vG,G)=genHelper.aaV(DstOp.sumVec,[vD])
159 :    
160 :     in (vG,code@code'@D@G)
161 :     end
162 :     |mkkrns _=raise Fail"Different structure"
163 :    
164 :    
165 :    
166 :    
167 :    
168 :    
169 :    
170 :     (*
171 :     fun genfn(Ein.EIN{params, index, body})= let
172 :     val sx= ref[]
173 :     val A=[DstOp.notDone]
174 :     fun gen body=(case body
175 :     of E.Field _ =>raise Fail(concat["Invalid Field here "] )
176 :     | E.Partial _ =>raise Fail(concat["Invalid Field here "] )
177 :     | E.Apply _ =>raise Fail(concat["Invalid Field here "] )
178 :     | E.Probe _ =>raise Fail(concat["Invalid Field here "] )
179 :     | E.Conv _ =>raise Fail(concat["Invalid Field here "] )
180 :     | E.Sum(sx', e)=> (sx:=sx'; gen e)
181 :    
182 :     (*Images and kernels*)
183 :     | E.Prod(E.Img im::es)=>let
184 :     val ref x=sx
185 :     in prodIter(body,index,x,mkkrns)
186 :     end
187 :     | E.Prod(E.Krn k1::es)=>let
188 :     val ref x=sx
189 :     in prodIter(body,index,x,mkkrns)
190 :     end
191 :     |_ => A
192 :     (*end case*))
193 :     in gen body end
194 :     *)
195 :    
196 :     end (* local *)
197 :    
198 :     end

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