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

SCM Repository

[diderot] Diff of /branches/charisee_dev/src/compiler/high-to-mid/ProbeEin.sml
ViewVC logotype

Diff of /branches/charisee_dev/src/compiler/high-to-mid/ProbeEin.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3369, Mon Nov 2 19:38:34 2015 UTC revision 3503, Thu Dec 17 23:13:57 2015 UTC
# Line 40  Line 40 
40      *)      *)
41    
42      val testing=0      val testing=0
     val testlift=1  
     val detflag =true  
     val fieldliftflag=true  
43      val valnumflag=true      val valnumflag=true
44        val tsplitvar=true
45        val fieldliftflag=true
46        val constflag=true
47        val detflag =true
48        val detsumflag=true
49        fun incUse (DstIL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
50        fun decUse (DstIL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
51    
52      val cnt = ref 0      val cnt = ref 0
53      fun transformToIndexSpace e=T.transformToIndexSpace e      fun transformToIndexSpace e=T.transformToIndexSpace e
# Line 52  Line 55 
55      fun toStringBind e=(MidToString.toStringBind e)      fun toStringBind e=(MidToString.toStringBind e)
56      fun mkEin e=Ein.mkEin e      fun mkEin e=Ein.mkEin e
57      fun mkEinApp(rator,args)=DstIL.EINAPP(rator,args)      fun mkEinApp(rator,args)=DstIL.EINAPP(rator,args)
58        fun setConst e = E.setConst e
59        fun setNeg e  =  E.setNeg e
60        fun setExp e  =  E.setExp e
61        fun setDiv e= E.setDiv e
62        fun setSub e= E.setSub e
63        fun setProd e= E.setProd e
64        fun setAdd e= E.setAdd e
65        fun mkCx es =List.map (fn c => E.C (c,true)) es
66        fun mkCxSingle c = E.C (c,true)
67    
68      fun testp n=(case testing      fun testp n=(case testing
69          of 0=> 1          of 0=> 1
# Line 76  Line 88 
88              in              in
89                ((Kernel.support h) ,img,ImageInfo.dim img)                ((Kernel.support h) ,img,ImageInfo.dim img)
90              end              end
91          |  _ => raise Fail "Expected Image and kernel arguments"              |  ((k,_),(i,_)) => raise Fail (String.concat["Expected kernel:", (DstOp.toString k ),"Expected Image:", (DstOp.toString i)])
92          (*end case*))          (*end case*))
93    
94    
# Line 104  Line 116 
116          (*1-d fields*)          (*1-d fields*)
117          fun createKRND1 ()=let          fun createKRND1 ()=let
118              val sum=sx              val sum=sx
119              val dels=List.map (fn e=>(E.C 0,e)) deltas              val dels=List.map (fn e=>(mkCxSingle 0,e)) deltas
120              val pos=[E.Add[E.Tensor(fid,[]),E.Value(sum)]]              val pos=[setAdd[E.Tensor(fid,[]),E.Value(sum)]]
121              val rest= E.Krn(hid,dels,E.Sub(E.Tensor(nid,[]),E.Value(sum)))              val rest= E.Krn(hid,dels,setSub(E.Tensor(nid,[]),E.Value(sum)))
122              in              in
123                  E.Prod [E.Img(Vid,alpha,pos),rest]                 setProd[E.Img(Vid,alpha,pos),rest]
124              end              end
125          (*createKRN Image field and kernels *)          (*createKRN Image field and kernels *)
126          fun createKRN(0,imgpos,rest)=E.Prod ([E.Img(Vid,alpha,imgpos)] @rest)          fun createKRN(0,imgpos,rest)=setProd ([E.Img(Vid,alpha,imgpos)] @rest)
127          | createKRN(dim,imgpos,rest)=let          | createKRN(dim,imgpos,rest)=let
128              val dim'=dim-1              val dim'=dim-1
129              val sum=sx+dim'              val sum=sx+dim'
130              val dels=List.map (fn e=>(E.C dim',e)) deltas              val dels=List.map (fn e=>(mkCxSingle  dim',e)) deltas
131              val pos=[E.Add[E.Tensor(fid,[E.C dim']),E.Value(sum)]]              val pos=[setAdd[E.Tensor(fid,[mkCxSingle dim']),E.Value(sum)]]
132              val rest'= E.Krn(hid,dels,E.Sub(E.Tensor(nid,[E.C dim']),E.Value(sum)))              val rest'= E.Krn(hid,dels,setSub(E.Tensor(nid,[mkCxSingle dim']),E.Value(sum)))
133              in              in
134                  createKRN(dim',pos@imgpos,[rest']@rest)                  createKRN(dim',pos@imgpos,[rest']@rest)
135              end              end
# Line 127  Line 139 
139              (*end case*))              (*end case*))
140          (*sumIndex creating summaiton Index for body*)          (*sumIndex creating summaiton Index for body*)
141          val slb=1-s          val slb=1-s
142            val _=List.tabulate(dim, (fn dim=> (String.concat[" sx:",Int.toString(sx)," dim:",Int.toString(dim),"esum",Int.toString(sx+dim) ]) ))
143          val esum=List.tabulate(dim, (fn dim=>(E.V (dim+sx),slb,s)))          val esum=List.tabulate(dim, (fn dim=>(E.V (dim+sx),slb,s)))
144      in      in
145          E.Sum(esum, exp)          E.Sum(esum, exp)
# Line 135  Line 148 
148      (*getsumshift:sum_indexid list* int list-> int      (*getsumshift:sum_indexid list* int list-> int
149      *get fresh/unused index_id, returns int      *get fresh/unused index_id, returns int
150      *)      *)
151      fun getsumshift(sx,index) =let      fun getsumshift(sx,n) =let
152          val nsumshift= (case sx          val nsumshift= (case sx
153              of []=> length(index)              of []=> n
154              | _=>let              | _=>let
155                  val (E.V v,_,_)=List.hd(List.rev sx)                  val (E.V v,_,_)=List.hd(List.rev sx)
156                  in v+1                  in v+1
157                  end                  end
158              (* end case *))              (* end case *))
159    
160          val aa=List.map (fn (E.V v,_,_)=>Int.toString v) sx          val aa=List.map (fn (E.V v,_,_)=>Int.toString v) sx
161          val _ =testp["\n", "SumIndex" ,(String.concatWith"," aa),          val _ =(String.concat["\n", "SumIndex:" ,(String.concatWith"," aa),
162              "\nThink nshift is ", Int.toString nsumshift]          "\n\t Index length:",Int.toString n,
163            "\n\t Freshindex: ", Int.toString nsumshift])
164          in          in
165              nsumshift              nsumshift
166          end          end
# Line 155  Line 170 
170      *)      *)
171      fun formBody(E.Sum([],e))=formBody e      fun formBody(E.Sum([],e))=formBody e
172      | formBody(E.Sum(sx,e))= E.Sum(sx,formBody e)      | formBody(E.Sum(sx,e))= E.Sum(sx,formBody e)
173      | formBody(E.Prod [e])=e      | formBody(E.Opn(E.Prod, [e]))=e
174      | formBody e=e      | formBody e=e
175    
176      (* silly change in order of the product to match vis branch WorldtoSpace functions*)      (* silly change in order of the product to match vis branch WorldtoSpace functions*)
177      fun multiPs([P0,P1,P2],sx,body)= formBody(E.Sum(sx, E.Prod([P0,P1,P2,body])))      fun multiPs([P0,P1,P2],sx,body)= formBody(E.Sum(sx, setProd[P0,P1,P2,body]))
178      (*      (*
179        | multiPs([P0,P1],sx,body)=formBody(E.Sum(sx, E.Prod([P0,body,P1])))        | multiPs([P0,P1],sx,body)=formBody(E.Sum(sx, setProd([P0,body,P1])))
180        *)        *)
181        | multiPs(Ps,sx,body)=formBody(E.Sum(sx, E.Prod([body]@Ps)))        | multiPs([P0,P1,P2,P3],sx,body)= formBody(E.Sum(sx, setProd[P0,P1,P2,P3,body]))
182          | multiPs(Ps,sx,body)=formBody(E.Sum(sx,setProd([body]@Ps)))
183    
184    
185      fun multiMergePs([P0,P1],[sx0,sx1],body)=E.Sum([sx0],E.Prod[P0,E.Sum([sx1],E.Prod[P1,body])])      fun multiMergePs([P0,P1],[sx0,sx1],body)=E.Sum([sx0],setProd[P0,E.Sum([sx1],setProd[P1,body])])
186        | multiMergePs e=multiPs e        | multiMergePs e=multiPs e
187    
188    
189      (* replaceProbe:ein_exp* params *midIL.var list * int list* sum_id list      (* *******************************************  Replace probe *******************************************  *)
190              -> ein_exp* *code      (* replaceProbe
191      * Transforms position to world space      * Transforms position to world space
192      * transforms result back to index_space      * transforms result back to index_space
193      * rewrites body      * rewrites body
194      * replace probe with expanded version      * replace probe with expanded version
195      *)      *)
196  (*    fun replaceProbe(testN,y,originalb,b,params,args,index, sx)*)       fun replaceProbe((y, DstIL.EINAPP(e,args)),p ,sx)
   
      fun replaceProbe(testN,(y, DstIL.EINAPP(e,args)),p ,sx)  
197          =let          =let
198          val originalb=Ein.body e          val originalb=Ein.body e
199          val params=Ein.params e          val params=Ein.params e
# Line 193  Line 207 
207          val Pid=nid+1          val Pid=nid+1
208          val nshift=length(dx)          val nshift=length(dx)
209          val (dim,argsA,code,s,PArg) = handleArgs(Vid,hid,tid,args)          val (dim,argsA,code,s,PArg) = handleArgs(Vid,hid,tid,args)
210          val freshIndex=getsumshift(sx,index)          val freshIndex=getsumshift(sx,length(index))
211          val (dx,newsx1,Ps)=transformToIndexSpace(freshIndex,dim,dx,Pid)          val (dx,newsx1,Ps)=transformToIndexSpace(freshIndex,dim,dx,Pid)
212          val params'=params@[E.TEN(3,[dim]),E.TEN(1,[dim]),E.TEN(1,[dim,dim])]          val params'=params@[E.TEN(3,[dim]),E.TEN(1,[dim]),E.TEN(1,[dim,dim])]
213          val body' = createBody(dim, s,freshIndex+nshift,alpha,dx,Vid, hid, nid, fid)          val body' = createBody(dim, s,freshIndex+nshift,alpha,dx,Vid, hid, nid, fid)
# Line 201  Line 215 
215    
216          val body'=(case originalb          val body'=(case originalb
217              of E.Sum(sx, E.Probe _)              => E.Sum(sx,body')              of E.Sum(sx, E.Probe _)              => E.Sum(sx,body')
218              | E.Sum(sx,E.Prod[eps0,E.Probe _ ])  => E.Sum(sx,E.Prod[eps0,body'])              | E.Sum(sx,E.Opn(E.Prod,[eps0,E.Probe _ ]))  => E.Sum(sx,setProd[eps0,body'])
219              | _                                  => body'              | _                                  => body'
220              (*end case*))              (*end case*))
221    
   
222          val args'=argsA@[PArg]          val args'=argsA@[PArg]
223          val einapp=(y,mkEinApp(mkEin(params',index,body'),args'))          val einapp=(y,mkEinApp(mkEin(params',index,body'),args'))
224          in          in
225              code@[einapp]              code@[einapp]
226          end          end
227    
228      val tsplitvar=true      (* ******************************************* Lift probe *******************************************  *)
229      fun createEinApp(originalb,alpha,index,freshIndex,dim,dx,sx)= let      fun createEinApp(originalb,alpha,index,freshIndex,dim,dx,sx)= let
230          val Pid=0          val Pid=0
231          val tid=1          val tid=1
# Line 233  Line 246 
246    
247          val tshape=filterAlpha(alpha')@newdx          val tshape=filterAlpha(alpha')@newdx
248          val t=E.Tensor(tid,tshape)          val t=E.Tensor(tid,tshape)
249    
250          val (splitvar,body)=(case originalb          val (splitvar,body)=(case originalb
251              of E.Sum(sx, E.Probe _)              => (false,E.Sum(sx,multiPs(Ps,newsx,t)))              of E.Sum(sx, E.Probe _)              => (true,multiPs(Ps,sx@newsx,t))
252              | E.Sum(sx,E.Prod[eps0,E.Probe _ ])  => (false,E.Sum(sx,E.Prod[eps0,multiPs(Ps,newsx,t)]))              | E.Sum(sx,E.Opn(E.Prod,[eps0,E.Probe _ ]))  => (false,E.Sum(sx,setProd[eps0,multiPs(Ps,newsx,t)]))
253              | _                                  => (case tsplitvar              | _                                  => (case tsplitvar
254                  of(* true =>   (true,multiMergePs(Ps,newsx,t))  (*pushes summations in place*)                  of(* true =>   (true,multiMergePs(Ps,newsx,t))  (*pushes summations in place*)
255                  | false*) _ =>   (true,multiPs(Ps,newsx,t))                  | false*) _ =>   (true,multiPs(Ps,newsx,t))
# Line 253  Line 267 
267              (splitvar,ein0,sizes,dx,alpha')              (splitvar,ein0,sizes,dx,alpha')
268          end          end
269    
270      fun liftProbe(printStrings,(y, DstIL.EINAPP(e,args)),p ,sx)=let      fun liftProbe((y, DstIL.EINAPP(e,args)),p ,sx)=let
271          val _=testp["\n******* Lift ******** \n"]          val _=testp["\n******* Lift Geneirc Probe ***\n"]
272          val originalb=Ein.body e          val originalb=Ein.body e
273          val params=Ein.params e          val params=Ein.params e
274          val index=Ein.index e          val index=Ein.index e
275          val _=  toStringBind (y, DstIL.EINAPP(e,args))          val _ =  (toStringBind (y, DstIL.EINAPP(e,args)))
276    
277          val E.Probe(E.Conv(Vid,alpha,hid,dx),E.Tensor(tid,_))=p          val E.Probe(E.Conv(Vid,alpha,hid,dx),E.Tensor(tid,_))=p
278          val fid=length(params)          val fid=length(params)
279          val nid=fid+1          val nid=fid+1
280          val nshift=length(dx)          val nshift=length(dx)
281          val (dim,args',code,s,PArg) = handleArgs(Vid,hid,tid,args)          val (dim,args',code,s,PArg) = handleArgs(Vid,hid,tid,args)
282          val freshIndex=getsumshift(sx,index)          val freshIndex=getsumshift(sx,length(index))
283    
284          (*transform T*P*P..Ps*)          (*transform T*P*P..Ps*)
285          val (splitvar,ein0,sizes,dx,alpha')= createEinApp(originalb,alpha,index,freshIndex,dim,dx,sx)          val (splitvar,ein0,sizes,dx,alpha')= createEinApp(originalb,alpha,index,freshIndex,dim,dx,sx)
286    
287          val FArg  = DstV.new ("F", DstTy.TensorTy(sizes))          val FArg  = DstV.new ("F", DstTy.TensorTy(sizes))
288          val einApp0=mkEinApp(ein0,[PArg,FArg])          val einApp0=mkEinApp(ein0,[PArg,FArg])
289          val rtn0=(case splitvar          val rtn0=(case splitvar
290              of false => [(y,mkEinApp(ein0,[PArg,FArg]))]              of false => [(y,mkEinApp(ein0,[PArg,FArg]))]
291              | _      => let              | _      => let
292                   val bind3 = (y,DstIL.EINAPP(SummationEin.main ein0,[PArg,FArg]))                   val bind3 = (y,DstIL.EINAPP(SummationEin.main ein0,[PArg,FArg]))
293                   in Split.splitEinApp(bind3,0)                   in Split.splitEinApp bind3
294                   end                   end
295              (*end case*))              (*end case*))
296    
297          (*lifted probe*)          (*lifted probe*)
298          val params'=params@[E.TEN(3,[dim]),E.TEN(1,[dim])]          val params'=params@[E.TEN(3,[dim]),E.TEN(1,[dim])]
299          val body' = createBody(dim, s,freshIndex+nshift,alpha',dx,Vid, hid, nid, fid)          val freshIndex'= length(sizes)
300    
301            val body' = createBody(dim, s,freshIndex',alpha',dx,Vid, hid, nid, fid)
302          val ein1=mkEin(params',sizes,body')          val ein1=mkEin(params',sizes,body')
303          val einApp1=mkEinApp(ein1,args')          val einApp1=mkEinApp(ein1,args')
304          val rtn1=(FArg,einApp1)          val rtn1=(FArg,einApp1)
305          val rtn=code@[rtn1]@rtn0          val rtn=code@[rtn1]@rtn0
306          val _= List.map toStringBind ([rtn1]@rtn0)          val _= List.map toStringBind ([rtn1]@rtn0)
307             val _=(String.concat["\n* end  Lift Geneirc Probe  ******** \n"])
308          in          in
309              rtn              rtn
310          end          end
311    
312        (* ******************************************* Reconstruction -> Lift|Replace probe *******************************************  *)
313        (* scans dx for contant
314         * arg:(1,code1, body1,[])
315         *)
316        fun reconstruction([],arg)= replaceProbe arg
317         | reconstruction(dx,arg)=(case (constflag,fieldliftflag)
318            of (true,true) => liftProbe arg
319            | (_,false)    => replaceProbe arg
320            | _ => let
321                fun fConst [] = liftProbe arg
322                | fConst (E.C _::_) = replaceProbe arg
323                | fConst (_ ::es)= fConst es
324                in fConst dx end
325            (* end case*))
326    
327      fun liftFieldMat(newvx,e)=      (* **************************************************** Index Tensor **************************************************** *)
328          let      (*Push constant indices to tensor replacement*)
329        fun getF (e,fieldset,dim,newvx)= let
330              val (y, DstIL.EINAPP(ein,args))=e              val (y, DstIL.EINAPP(ein,args))=e
             val E.Probe(E.Conv(V,[c1,v0],h,dx),pos)=Ein.body ein  
331              val index0=Ein.index ein              val index0=Ein.index ein
332              val index1 = index0@[3]          val index1 = index0@dim
333            val b=Ein.body ein
334    
335            val (c1,dx,body1)=(case b
336                of  E.Sum([(vsum,0,n)],E.Probe(E.Conv(V,[c1,v0],h,dx),pos))=>let
337                    val shiftdx=List.tabulate(length(dx),fn n=>E.V (n+2))
338                    val b=E.Probe(E.Conv(V,[E.V 0,E.V 1],h,shiftdx),pos)
339                    in (c1,dx,b) end
340                | E.Probe(E.Conv(V,[c1,v0],h,dx),pos)=> let
341              val body1_unshifted = E.Probe(E.Conv(V,[E.V newvx, v0],h,dx),pos)              val body1_unshifted = E.Probe(E.Conv(V,[E.V newvx, v0],h,dx),pos)
342              (* clean to get body indices in order *)              (* clean to get body indices in order *)
343              val ( _ , _, body1)= cleanIndex.cleanIndex(body1_unshifted,index1,[])              val ( _ , _, body1)= cleanIndex.cleanIndex(body1_unshifted,index1,[])
344              val _ = testp ["\n Shifted ",P.printbody body1_unshifted,"=>",P.printbody body1]                  in (c1,dx,body1) end
345                |  E.Probe(E.Conv(V,[c1],h,dx),pos)=> let
346              val lhs1=DstV.new ("L", DstTy.TensorTy(index1))                 val body1_unshifted= E.Probe(E.Conv(V,[E.V newvx],h,dx),pos)
347              val ein1 = mkEin(Ein.params ein,index1,body1)                 val ( _ , _, body1)= cleanIndex.cleanIndex(body1_unshifted,index1,[])
348              val code1= (lhs1,mkEinApp(ein1,args))                 in (c1,dx,body1) end
             val codeAll= (case dx  
             of []=> replaceProbe(1,code1,body1,[])  
             | _ =>liftProbe(1,code1,body1,[])  
349              (*end case*))              (*end case*))
350    
             (*Probe that tensor at a constant position  c1*)  
             val param0 = [E.TEN(1,index1)]  
             val nx=List.tabulate(length(dx)+1,fn n=>E.V n)  
             val body0 =  E.Tensor(0,[c1]@nx)  
             val ein0 = mkEin(param0,index0,body0)  
             val einApp0 = mkEinApp(ein0,[lhs1])  
             val code0 = (y,einApp0)  
             val _= toStringBind code0  
         in  
             codeAll@[code0]  
     end  
   
     fun liftFieldSum e =  
     let  
         val _=print"\n*************************************\n"  
         val (y, DstIL.EINAPP(ein,args))=e  
         val E.Sum([(vsum,0,n)],E.Probe(E.Conv(V,[c1,v0],h,dx),pos))=Ein.body ein  
         val index0=Ein.index ein  
         val index1 = index0@[3]@[3]  
         val shiftdx=List.tabulate(length(dx),fn n=>E.V (n+2))  
         val body1 = E.Probe(E.Conv(V,[E.V 0,E.V 1],h,shiftdx),pos)  
   
   
351          val lhs1=DstV.new ("L", DstTy.TensorTy(index1))          val lhs1=DstV.new ("L", DstTy.TensorTy(index1))
352          val ein1 = mkEin(Ein.params ein,index1,body1)          val ein1 = mkEin(Ein.params ein,index1,body1)
353          val code1= (lhs1,mkEinApp(ein1,args))          val code1= (lhs1,mkEinApp(ein1,args))
354          val codeAll= (case dx  
355          of []=> replaceProbe(1,code1,body1,[])          val (_,(lhs0,codeAll))= (case valnumflag
356          | _ =>liftProbe(1,code1,body1,[])              of false    => (fieldset,(lhs1, reconstruction(dx,(code1,body1,[]))))
357                | true      => (case  (einVarSet.rtnVarN(fieldset,code1))
358                    of (fieldset,NONE)     => (fieldset,(lhs1, reconstruction(dx,(code1,body1,[]))))
359                    | (fieldset,SOME m)   =>  (fieldset,(m,[]))
360                    (*end case*))
361          (*end case*))          (*end case*))
362    
363          (*Probe that tensor at a constant position  c1*)          (*Probe that tensor at a constant position  c1*)
364          val param0 = [E.TEN(1,index1)]          val param0 = [E.TEN(1,index1)]
365          val nx=List.tabulate(length(dx),fn n=>E.V n)          val nx=List.tabulate(newvx,fn n=>E.V n)
366          val body0 =  E.Sum([(vsum,0,n)],E.Tensor(0,[vsum,vsum]@nx))          val body0 =  (case b
367                of E.Sum([(vsum,0,n)],_)=>  E.Sum([(vsum,0,n)],E.Tensor(0,[vsum,vsum]@nx))
368                | _ => E.Tensor(0,[c1]@nx)
369                (*end case*))
370          val ein0 = mkEin(param0,index0,body0)          val ein0 = mkEin(param0,index0,body0)
371          val einApp0 = mkEinApp(ein0,[lhs1])          val einApp0 = mkEinApp(ein0,[lhs0])
372          val code0 = (y,einApp0)          val code0 = (y,einApp0)
         val _= toStringBind  e  
373          val _ =toStringBind code0          val _ =toStringBind code0
        val _ = (String.concat  ["\norig",P.printbody(Ein.body ein),"\n replace i  ",P.printbody body1,"\nfreshtensor",P.printbody body0])  
        val _ =(String.concat(List.map toStringBind (codeAll@[code0])))  
                val _=print"\n*************************************\n"  
374          in          in
375          codeAll@[code0]          codeAll@[code0]
376      end      end
377        (* **************************************************** General Fn **************************************************** *)
   
378      (* expandEinOp: code->  code list      (* expandEinOp: code->  code list
379      * A this point we only have simple ein ops      * A this point we only have simple ein ops
380      * Looks to see if the expression has a probe. If so, replaces it.      * Looks to see if the expression has a probe. If so, replaces it.
381      * Note how we keeps eps expressions so only generate pieces that are used      * Note how we keeps eps expressions so only generate pieces that are used
382      *)      *)
383     fun expandEinOp( e as (y, DstIL.EINAPP(ein,args)),fieldset)=let      fun expandEinOp( e0 as (y, DstIL.EINAPP(ein,args)),fieldset,varset)=let
384            fun rewriteBody(e,p as E.Probe(E.Conv(_,alpha,_,dx),_))= (case (detflag,alpha,dx)
385          fun checkConst ([],a) =              of (true,[E.C(_,true), E.V 0],[])            => getF(e,fieldset,[3],1)
386              (case fieldliftflag              | (true,[E.C(_,true), E.V 0],[E.V 1])        => getF(e,fieldset,[3],2)
387                  of true => liftProbe a              | (true,[E.C(_,true), E.V 0],[E.V 1,E.V 2])  => getF(e,fieldset,[3],3)
388                  | _ => replaceProbe a              | (true,[E.C(_,true)],[])                    => getF(e,fieldset,[3],0)
389              (*end case*))              | (true,[E.C(_,true)],[E.V 0])               => getF(e,fieldset,[3],1)
390          | checkConst ((E.C _::_),a) = replaceProbe a              | (true,[E.C(_,true)],[E.V 0,E.V 1])         => getF(e,fieldset,[3],2)
391          | checkConst ((_ ::es),a)= checkConst(es,a)              | (true,[E.C(_,true)],[E.V 0,E.V 1,E.V 2])   => getF(e,fieldset,[3],3)
392                | _                                          => reconstruction(dx,(e,p,[]))
393          fun rewriteBody b=(case (detflag,b)              (*end case*))
394              of (true,E.Probe(E.Conv(_,[E.C _ ,E.V 0],_,[]),pos))          | rewriteBody(e,E.Sum(sx,p as E.Probe(E.Conv(_,alpha,_,dx),_)))= (case (detsumflag,sx,alpha,dx)
395                  => liftFieldMat (1,e)              of (true,[(E.V 0,0,_)],[E.V 0 ,E.V 0],[])              => getF(e,fieldset,[3,3],0)
396              | (true,E.Probe(E.Conv(_,[E.C _ ,E.V 0],_,[E.V 1]),pos))              | (true,[(E.V 1,0,_)],[E.V 1 ,E.V 1],[E.V 0])          => getF(e,fieldset,[3,3],1)
397                  => liftFieldMat (2,e)              | (true,[(E.V 2,0,_)],[E.V 2 ,E.V 2],[E.V 0,E.V 1])    => getF(e,fieldset,[3,3],2)
398              | (true,E.Probe(E.Conv(_,[E.C _ ,E.V 0],_,[E.V 1,E.V 2] ),pos))              | (_,_,_,[])                                => replaceProbe(e,p, sx)  (*no dx*)
399                  => liftFieldMat (3,e)              | (_,_,[],_)                                => reconstruction(dx,(e,p,sx))
400              | (true, E.Sum([(E.V 0,0,_)],E.Probe(E.Conv(_,[E.V 0 ,E.V 0],_,[]),pos)))              | _                                         => replaceProbe(e,p, sx)
                 => liftFieldSum e  
             | (true, E.Sum([(E.V 1,0,_)],E.Probe(E.Conv(_,[E.V 1 ,E.V 1],_,[E.V 0]),pos)))  
                 => liftFieldSum e  
             | (true, E.Sum([(E.V 2,0,_)],E.Probe(E.Conv(_,[E.V 2 ,E.V 2],_,[E.V 0,E.V 1]),pos)))  
                 => liftFieldSum e  
   
   
             | (_,E.Probe(E.Conv(_,_,_,[]),_))  
                 => replaceProbe(0,e,b,[])  
             | (_,E.Probe(E.Conv (_,alpha,_,dx),_))  
                 => checkConst(dx,(0,e,b,[])) (*scans dx for contant*)  
             | (_,E.Sum(sx,p as E.Probe(E.Conv(_,_,_,[]),_)))  
                 => replaceProbe(0,e,p, sx)  (*no dx*)  
             | (_,E.Sum(sx,p as E.Probe(E.Conv(_,[],_,dx),_)))  
                 => checkConst(dx,(0,e,p,sx)) (*scalar field*)  
             | (_,E.Sum(sx,E.Probe p))  
                 => replaceProbe(0,e,E.Probe p, sx)  
             | (_,E.Sum(sx,E.Prod[eps,E.Probe p]))  
                 => replaceProbe(0,e,E.Probe p,sx)  
             | (_,_) => [e]  
             (* end case *))  
   
         val (fieldset,var) = (case valnumflag  
             of true => einSet.rtnVar(fieldset,y,DstIL.EINAPP(ein,args))  
             | _     => (fieldset,NONE)  
401          (*end case*))          (*end case*))
402            | rewriteBody(e,E.Sum(sx,E.Opn(E.Prod,[eps,E.Probe p])))     = replaceProbe(e,E.Probe p,sx)
403            | rewriteBody (e,_)  = [e]
404    
405          fun matchField b=(case b          val b=Ein.body ein
406            fun matchField()=(case b
407              of E.Probe _ => 1              of E.Probe _ => 1
408              | E.Sum (_, E.Probe _)=>1              | E.Sum (_, E.Probe _)=>1
409              | E.Sum(_, E.Prod[ _ ,E.Probe _])=>1              | E.Sum(_, E.Opn(E.Prod,[ _ ,E.Probe _]))=>1
410              | _ =>0              | _ =>0
411              (*end case*))              (*end case*))
412          fun toStrField b=(case b          val (fieldset,varset,code,flag) = (case valnumflag
413              of E.Probe _ => print ("\n"^(P.printbody b))              of true => (case (einVarSet.rtnVarN(fieldset,e0))
414              | E.Sum (_, E.Probe _)=>print("\n"^ (P.printbody b))                 of  (fldset,NONE)     => (fldset,varset,rewriteBody(e0,b),0)
415              | E.Sum(_, E.Prod[ _ ,E.Probe _])=>print("\n"^ (P.printbody b))                | (fldset,SOME v)    => (fldset,varset,[(y,DstIL.VAR v)],1)
416              | _ =>print ""                   (*of (fldset, NONE)      => (fldset,varset,rewriteBody((y,DstIL.EINAPP(ein,List.map (fn a=>einVarSet.replaceArg(varset,a)) args)), b),0)
417                     | (fldset,SOME v)    => (fldset,einVarSet.VarSet.add(varset,einVarSet.VAR(v,y)),[],1)*)
418              (*end case*))              (*end case*))
419              val b=Ein.body ein              | _     => (fieldset,varset,rewriteBody(e0, b),0)
   
         val _=  toStrField b  
   
         in  (case var  
             of NONE=> ((rewriteBody(Ein.body ein),fieldset,matchField(Ein.body ein),0))  
             | SOME v=> (("\n mapp_replacing"^(P.printerE ein)^":");( [(y,DstIL.VAR v)],fieldset, matchField(Ein.body ein),1))  
420              (*end case*))              (*end case*))
421          end          val m=matchField()
422            in  (code,fieldset,varset,m,flag) end
423    
424    end; (* local *)    end; (* local *)
425    

Legend:
Removed from v.3369  
changed lines
  Added in v.3503

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