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

SCM Repository

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

Annotation of /branches/charisee/src/compiler/ein/filter-ein.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2611 - (view) (download)

1 : cchiw 2605
2 :     structure Filter = struct
3 :    
4 :     local
5 :    
6 :     structure E = Ein
7 :     structure P=Printer
8 :     in
9 :    
10 :     fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])
11 :    
12 :     (*Flattens Add constructor: change, expression *)
13 :     fun mkAdd [e]=(1,e)
14 :     | mkAdd(e)=let
15 :     fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')
16 :     |flatten(i,((E.Const c):: l'))=
17 :     if (c>0 orelse 0>c) then let
18 :     val (b,a)=flatten(i,l') in (b,[E.Const c]@a) end
19 :     else flatten(1,l')
20 :     | flatten(i,[])=(i,[])
21 :     | flatten (i,e::l') = let
22 :     val(b,a)=flatten(i,l') in (b,[e]@a) end
23 :    
24 :     val (b,a)=flatten(0,e)
25 :     in case a
26 :     of [] => (1,E.Const(1))
27 :     | [e] => (1,e)
28 :     | es => (b,E.Add es)
29 :     (* end case *)
30 :     end
31 :    
32 :    
33 :     fun mkProd [e]=(1,e)
34 :     | mkProd(e)=let
35 :     fun flatten(i,((E.Prod l)::l'))= flatten(1,l@l')
36 :     |flatten(i,((E.Const c)::l'))=
37 :     if(c>0 orelse 0>c) then (3,[E.Const 0])
38 :     else flatten(i,l')
39 :     | flatten(i,[])=(i,[])
40 :     | flatten (i,e::l') = let val(a,b)=flatten(i,l') in (a,[e]@b) end
41 :     val (change,a)=flatten(0,e)
42 :     in if(change=3) then (1,E.Const(0))
43 :     else case a
44 :     of [] => (1,E.Const(0))
45 :     | [e] => (1,e)
46 :     | es => (change, E.Prod es)
47 :     (* end case *)
48 :     end
49 :    
50 :    
51 :     (*filter scalars and greeks*)
52 :     fun filterGreek e= let
53 :     fun filter([],pre,eps,dels, post)=(pre,eps,dels ,post)
54 :     | filter(e1::es,pre,eps,dels, post)=(case e1
55 :     of E.Prod p => filter(p@es, pre, eps,dels,post)
56 :     | E.Field(_,[]) => filter(es, pre@[e1], eps,dels,post)
57 :     | E.Conv(_,[],_,[]) => filter(es, pre@[e1], eps,dels,post)
58 :     | E.Probe(E.Field(_,[]),_) => filter(es, pre@[e1], eps,dels,post)
59 :     | E.Probe(E.Conv(_,[],_,[]),_) => filter(es, pre@[e1], eps,dels,post)
60 :     | E.Tensor(id,[]) => filter(es, pre@[e1], eps,dels,post)
61 :     | E.Const _ => filter(es, pre@[e1], eps,dels,post)
62 :     | E.Epsilon _ => filter(es, pre,eps@[e1],dels, post)
63 :     | E.Delta _ => filter(es, pre,eps,dels@[e1], post)
64 :     | _ => filter(es, pre, eps, dels, post@[e1])
65 :     (*end case *))
66 :     in filter(e,[],[],[],[])
67 :     end
68 :    
69 :    
70 :     (* Note Lift indicates a Tensor*)
71 :     (*So expression is either Lift, del, eps, or contains a Field*)
72 :     fun filterField e= let
73 :     fun filter([],pre,post)=(pre,post)
74 :     | filter(e1::es, pre,post)=(case e1
75 :     of E.Prod p => filter(p@es, pre, post)
76 :     | E.Lift _ => filter(es, pre@[e1], post)
77 :     | E.Epsilon _ => filter(es, pre@[e1], post)
78 :     | E.Delta _ => filter(es, pre@[e1], post)
79 :     | _ => filter(es,pre, post@[e1])
80 :     (*end case*))
81 :     in filter(e,[],[])
82 :     end
83 :    
84 :    
85 :     fun filterPartial([])=[]
86 :     | filterPartial(E.Partial d1::es)=d1@filterPartial(es)
87 :     | filterPartial _= err"Found non-Partial in Apply"
88 :    
89 : cchiw 2611
90 :     fun filterEps eps=let
91 :     fun findeps(eps,[],rest) = (eps,rest,[])
92 :     | findeps(eps,e1::es,rest)=(case e1
93 :     of (E.Epsilon eps1) => findeps(eps@[e1],es,rest)
94 :     | E.Prod p => findeps(eps,p@es, rest)
95 :     | E.Field _ => findeps(eps,es,rest@[e1])
96 :     | E.Tensor _ => findeps(eps,es,rest@[e1])
97 :     | E.Sum(c,E.Prod(E.Epsilon eps1::ps)) => (eps,rest@es,[e1])
98 :     | _ => (eps,rest@[e1]@es,[])
99 :     (*end case*))
100 :     in
101 :     findeps([], eps,[])
102 :     end
103 :    
104 : cchiw 2605 (* filter Scalars outside Summation product *)
105 :     fun filterSca(c,e)= let
106 :     fun filter([],[],[post])=(0,E.Sum(c,post))
107 :     | filter([],[],post)=(0,E.Sum(c,E.Prod(post)))
108 :     | filter([],pre,[post])=(1,E.Prod(pre@[E.Sum(c,post)]))
109 :     | filter([],pre,post)=(1,E.Prod(pre@[E.Sum(c,E.Prod(post))]))
110 :     | filter(e1::es, pre,post)=(case e1
111 :     of E.Prod p => filter(p@es, pre, post)
112 :     | E.Field(_,[]) => filter(es, pre@[e1], post)
113 :     | E.Conv(_,[],_,[]) => filter(es, pre@[e1], post)
114 :     | E.Probe(E.Field(_,[]),_) => filter(es, pre@[e1], post)
115 :     | E.Probe(E.Conv(_,[],_,[]),_) => filter(es, pre@[e1], post)
116 :     | E.Tensor(id,[]) => filter(es, pre@[e1], post)
117 :     | E.Const _ => filter(es, pre@[e1], post)
118 :     | _ => filter(es,pre, post@[e1])
119 :     (*end case*))
120 :     in filter(e,[],[])
121 :     end
122 :    
123 :    
124 :     fun findIndex(v,searchspace )=List.find (fn x => x = v) searchspace
125 :    
126 :    
127 :     (*Question is c, in e *)
128 :     fun foundSx(c,e)=let
129 :    
130 :     fun sort []= NONE
131 :     | sort(e1::es)= (case foundSx(c, e1)
132 :     of NONE => sort(es)
133 :     |SOME s => SOME s
134 :     (*end case *))
135 :    
136 :     in (case e
137 :     of E.Krn _ => raise Fail"Krn used pre expansion"
138 :     | E.Img _ => raise Fail"Img used pre expansion"
139 :     | E.Value _ => NONE
140 :     | E.Const _ => NONE
141 :     | E.Tensor(id,[]) => NONE
142 :     | E.Conv(v,[],h,[]) => NONE
143 :     | E.Probe(E.Conv(v,[],h,[]),E.Tensor(t,[])) => NONE
144 :     | E.Tensor(id,shape) => findIndex(c,shape)
145 :     | E.Field(id,shape) => findIndex(c,shape)
146 :     | E.Delta(i,j) => findIndex(c, [i,j])
147 :     | E.Epsilon (i,j,k) => findIndex(c,[E.V i,E.V j,E.V k])
148 :     | E.Partial (shape) => findIndex(c,shape)
149 :     | E.Conv(_ , alpha, _ , dx) => findIndex(c, alpha@dx)
150 :     | E.Neg a => foundSx(c,a)
151 :     | E.Lift a => foundSx(c,a)
152 :     | E.Sum(_,a) => foundSx(c,a)
153 :     | E.Apply(e1,e2) => sort([e1,e2])
154 :     | E.Sub(e1,e2) => sort([e1,e2])
155 :     | E.Div(e1,e2) => sort([e1,e2])
156 :     | E.Probe(e1,e2) => sort([e1,e2])
157 :     | E.Prod a => sort a
158 :     | E.Add a => sort a
159 :     (*end case*))
160 :     end
161 :    
162 :    
163 :    
164 :     (*Approach, Look to see if each expression has index,
165 :     flattens product, does no other rewriting.
166 :     *)
167 :    
168 :     fun pushSum(c,p)= let
169 :     val (v, lb, ub)=c
170 :     fun filter([],[keep],[])= (0,E.Sum([c],keep))
171 :     | filter([],keep,[])= (0,E.Sum([c],E.Prod(keep)))
172 :     | filter(s,[],[])= (1,E.Prod(s))
173 :     | filter(s,[keep],[])= (1,E.Prod(s@[E.Sum([c],keep)]))
174 :     | filter(s,keep,[])= (1,E.Prod(s@[E.Sum([c],E.Prod(keep))]))
175 :     | filter(s,keep,e1::es)= (case e1
176 :     of E.Prod p=> filter(s,keep, p@es)
177 :     | _ =>(case foundSx(v,e1)
178 :     of NONE => filter(s@[e1],keep,es)
179 :     | SOME _ => filter(s,keep@[e1],es)
180 :     (*end case*))
181 :     (*end case*))
182 :     in filter([],[],p)
183 :     end
184 :    
185 :     fun splitSum(c,p)= let
186 :     val (v, lb, ub)=c
187 :     fun filter(s,keep,[])=(s,keep)
188 :     | filter(s,keep,e1::es)= (case e1
189 :     of E.Prod p=> filter(s,keep, p@es)
190 :     | _ =>(case foundSx(v,e1)
191 :     of NONE => filter(s@[e1],keep,es)
192 :     | SOME _ => filter(s,keep@[e1],es)
193 :     (*end case*))
194 :     (*end case*))
195 :     in filter([],[],p)
196 :     end
197 :    
198 : cchiw 2611 (*Count Occurences*)
199 :     fun findOcc(i,[])=0
200 :     | findOcc(i,E.V v::es)=if(i=v) then 1+findOcc(i, es) else findOcc(i,es)
201 :     | findOcc(i,v::es)=findOcc(i, es)
202 : cchiw 2605
203 : cchiw 2611
204 : cchiw 2605 end
205 :    
206 :    
207 :    
208 :     end (* local *)

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