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

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/ein/rewriteIndices.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/ein/rewriteIndices.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2870 - (view) (download)

1 : cchiw 2867 structure rewriteIndices= struct
2 :    
3 :     local
4 :    
5 :     structure E = Ein
6 :     structure P=Printer
7 :     structure S=getShape
8 :    
9 :     in
10 :     val testing=0
11 :     fun iTos i =Int.toString i
12 :     fun lookup k d = d k
13 :     fun err str=raise Fail str
14 :     fun testp n=(case testing
15 :     of 0=> 1
16 :     | _ =>(print(String.concat n);1)
17 :     (*end case*))
18 :    
19 :     (*dictionary to lookup mapp*)
20 :     fun lkupIndexSingle(e1,mapp,str)=(case (lookup e1 mapp)
21 :     of SOME l=>l
22 :     | _=> raise Fail(str^iTos(e1))
23 :     (*endcase*))
24 :     fun lkupIndexV(E.V e1,mapp,str)=E.V (lkupIndexSingle(e1,mapp,str))
25 :     | lkupIndexV(E.C e1,mapp,_)=E.C e1
26 :     fun lkupIndexSx([],mapp,str)=[]
27 :     | lkupIndexSx((E.V e1,ub,lb)::es,mapp,str)=(case (lookup e1 mapp)
28 :     of SOME l =>[(E.V l,ub,lb)]@lkupIndexSx(es, mapp,str)
29 :     |_ =>[]@lkupIndexSx(es, mapp,str)
30 :     (*end case*))
31 :    
32 :     (* rewriteIndices:dict*ein_exp ->ein_exp
33 :     * rewrites indices in e using mapp
34 :     *)
35 :     fun rewrite(mapp,e)=let
36 :    
37 :     val str="Error indexMapp from expression:"^P.printbody e^"Index"
38 :     fun getAlpha alpha = List.map (fn e=>lkupIndexV(e,mapp,str)) alpha
39 :     fun getIx ix= lkupIndexSingle(ix,mapp,str)
40 :     fun getVx ix= lkupIndexV (ix,mapp,str)
41 :     fun getSx sx =lkupIndexSx(sx,mapp,str)
42 :     fun rewriteExp e=(case e
43 :     of E.Tensor(id,alpha) => E.Tensor(id, getAlpha alpha)
44 :     | E.Add e => E.Add(List.map rewriteExp e)
45 :     | E.Sub(e1,e2) => E.Sub(rewriteExp e1,rewriteExp e2)
46 :     | E.Div(e1,e2) => E.Div(rewriteExp e1,rewriteExp e2)
47 :     | E.Sum(sx ,e) => E.Sum(getSx sx ,rewriteExp e)
48 :     | E.Prod e => E.Prod(List.map rewriteExp e)
49 :     | E.Neg e => E.Neg(rewriteExp e)
50 :     | E.Probe(E.Conv(v,alpha,h,dx) ,t) => E.Probe(E.Conv (v, getAlpha alpha,h, getAlpha dx), rewriteExp t)
51 :     | E.Delta(i,j) => E.Delta(getVx i,getVx j)
52 :     | E.Epsilon(i,j,k) => E.Epsilon(getIx i,getIx j,getIx k)
53 :     | E.Eps2(i,j) => E.Eps2(getIx i,getIx j)
54 :     | E.Sqrt e => E.Sqrt(rewriteExp e)
55 : cchiw 2870 | E.PowInt(e,n1) => E.PowInt(rewriteExp e,n1)
56 :     | E.PowReal(e,n1) => E.PowReal(rewriteExp e,n1)
57 : cchiw 2867 | E.Const _ => e
58 : cchiw 2870 | E.ConstR _ => e
59 : cchiw 2867 | E.Field _ => E.Const 0
60 :     | E.Partial _ => E.Const 0
61 :     | E.Apply _ => E.Const 0
62 :     | E.Lift _ => E.Const 0
63 :     | E.Probe _ => E.Const 0
64 :     | E.Conv _ => E.Const 0
65 :     | E.Img _ => raise Fail "should not be here"
66 :     | E.Value e1 => raise Fail"Should not be here"
67 :     | E.Krn _ => raise Fail"Should not be here"
68 :     (*end case*))
69 :     in
70 :     rewriteExp e
71 :     end
72 :    
73 :     end; (* local *)
74 :    
75 :     end (* local *)

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