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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2870 - (view) (download)

1 : cchiw 2844 (*
2 : cchiw 2845 *A collection of Fiter function that are used to organize ein_exps
3 :     *Some of them are only use by 1 file and could be moved there
4 :     *Files include order-ein,normalize-ein,and move_sum
5 : cchiw 2844 *)
6 :     structure Filter = struct
7 :     local
8 :    
9 :     structure E = Ein
10 :     structure P=Printer
11 :     in
12 :    
13 : cchiw 2845 fun err str=raise Fail (String.concat["Ill-formed EIN Operator",str])
14 : cchiw 2844
15 :    
16 : cchiw 2845 (************** Group of functions that rewrites ein_exp********)
17 :     (* mkAdd:ein_exp list->int* ein_exp
18 :     *Flattens Add constructor: change, expression
19 :     *)
20 :     fun mkAdd [e]=(1,e)
21 :     | mkAdd(e)=let
22 :     fun flatten((i, (E.Add l)::l'))= flatten(1,l@l')
23 :     | flatten(i,((E.Const c):: l'))=
24 :     if (c>0 orelse 0>c) then let
25 :     val (b,a)=flatten(i,l') in (b,[E.Const c]@a) end
26 :     else flatten(1,l')
27 :     | flatten(i,[])=(i,[])
28 :     | flatten (i,e::l') = let
29 :     val(b,a)=flatten(i,l') in (b,[e]@a) end
30 : cchiw 2844
31 : cchiw 2845 val (b,a)=flatten(0,e)
32 :     in case a
33 : cchiw 2856 of [] => (1,E.Const(0))
34 : cchiw 2844 | [e] => (1,e)
35 : cchiw 2845 | es => (b,E.Add es)
36 : cchiw 2844 (* end case *)
37 : cchiw 2845 end
38 :    
39 :     (* mkProd:ein_exp list->int* ein_exp
40 :     *Flattens Add constructor: change, expression
41 :     *)
42 :     fun mkProd [e]=(1,e)
43 :     | mkProd(e)=let
44 :     fun flatten(i,((E.Prod l)::l'))= flatten(1,l@l')
45 :     | flatten(i,((E.Const 0)::l'))=(3,[E.Const 0])
46 :     | flatten(i,((E.Const 1)::l'))=flatten(1,l')
47 :     | flatten(i,[])=(i,[])
48 :     | flatten (i,e::l') = let val(a,b)=flatten(i,l') in (a,[e]@b) end
49 :     val (change,a)=flatten(0,e)
50 :     in if(change=3) then (1,E.Const(0))
51 :     else case a
52 :     of [] => (1,E.Const(0))
53 :     | [e] => (1,e)
54 :     | es => (change, E.Prod es)
55 :     (* end case *)
56 :     end
57 : cchiw 2844
58 :    
59 : cchiw 2845 (*rewriteProd: ein_exp list -> ein_exp
60 :     * rewrite. Prod A
61 :     *used by move_sum.sml
62 :     *)
63 :     fun rewriteProd A=(case A
64 :     of [A]=> A
65 :     | A => E.Prod A
66 :     (*end case*))
67 :     (*
68 :     fun mkProd e=let
69 :     fun flatten([],[])=(1,E.Const 1)
70 :     | flatten([],rest)=(0,rewriteProd rest)
71 :     | flatten((E.Const 0)::es,_)=(1,E.Const 0)
72 :     | flatten((E.Const 1)::es,rest)=flatten(es, rest)
73 :     | flatten((E.Prod p)::es,rest)=flatten(p@es,E.Prod rest)
74 :     | flatten(e1::es,rest)=flatten(es,rest@[e1])
75 :     in
76 :     flatten(e,[])
77 :     end
78 : cchiw 2844 *)
79 : cchiw 2845 (*rewriteSum:sum_indexid list* ein_exp list -> ein_exp
80 :     * rewrite. Sum(c,Prod p))
81 :     *used by move_sum.sml
82 :     *)
83 :     fun rewriteSum(c,p)= E.Sum(c, rewriteProd p)
84 : cchiw 2844
85 :    
86 : cchiw 2845 (*rewriteProdSum:ein_exp list*sum_indexid list* ein_exp list -> ein_exp
87 :     * rewrite. Prod( pre*Sum(out,Prod post))
88 :     *used by move_sum.sml
89 :     *)
90 :     fun rewriteProdSum(pre,_,[])=rewriteProd pre
91 :     | rewriteProdSum(pre,outer,post)=rewriteProd(pre@[rewriteSum(outer,post)])
92 : cchiw 2844
93 :    
94 : cchiw 2845 (************************* Group of functions that filter product *******************************)
95 : cchiw 2844
96 : cchiw 2845 (* filterGreek:ein_exp list ->ein_exp list*ein_exp list*ein_exp list*ein_exp list
97 :     *filter scalars and greeks
98 :     *used by order-ein.sml
99 :     *)
100 :     fun filterGreek e= let
101 :     fun filter([],pre,eps,dels, post)=(pre,eps,dels ,post)
102 :     | filter(e1::es,pre,eps,dels, post)=(case e1
103 :     of E.Prod p => filter(p@es, pre, eps,dels,post)
104 :     | E.Field(_,[]) => filter(es, pre@[e1], eps,dels,post)
105 :     | E.Conv(_,[],_,[]) => filter(es, pre@[e1], eps,dels,post)
106 :     | E.Probe(E.Field(_,[]),_) => filter(es, pre@[e1], eps,dels,post)
107 :     | E.Probe(E.Conv(_,[],_,[]),_) => filter(es, pre@[e1], eps,dels,post)
108 :     | E.Tensor(id,[]) => filter(es, pre@[e1], eps,dels,post)
109 :     | E.Const _ => filter(es, pre@[e1], eps,dels,post)
110 :     | E.Epsilon _ => filter(es, pre,eps@[e1],dels, post)
111 :     | E.Delta _ => filter(es, pre,eps,dels@[e1], post)
112 :     | _ => filter(es, pre, eps, dels, post@[e1])
113 :     (*end case *))
114 :     in
115 :     filter(e,[],[],[],[])
116 : cchiw 2844 end
117 : cchiw 2845
118 :    
119 :     (*filterField:ein_exp list->ein_exp list * ein_exp list
120 :     * Note Lift indicates a Tensor
121 :     * So expression is either Lift, del, eps, or contains a Field
122 :     *used by order-ein.sml
123 :     *)
124 :     fun filterField e= let
125 :     fun filter([],pre,post)=(pre,post)
126 :     | filter(e1::es, pre,post)=(case e1
127 :     of E.Prod p => filter(p@es, pre, post)
128 :     | E.Lift _ => filter(es, pre@[e1], post)
129 :     | E.Epsilon _ => filter(es, pre@[e1], post)
130 :     | E.Eps2 _ => filter(es, pre@[e1], post)
131 :     | E.Delta _ => filter(es, pre@[e1], post)
132 : cchiw 2870 | E.Const _ => filter(es, pre@[e1], post)
133 : cchiw 2845 | _ => filter(es,pre, post@[e1])
134 :     (*end case*))
135 :     in filter(e,[],[])
136 :     end
137 :    
138 :     (*filterPartial:ein_exp list-> mu list
139 :     * peels mu in partial expression
140 :     *)
141 :     fun filterPartial([])=[]
142 :     | filterPartial(E.Partial d1::es)=d1@filterPartial(es)
143 :     | filterPartial _= err"Found non-Partial in Apply"
144 : cchiw 2844
145 :    
146 : cchiw 2845 (*filterEps:ein_exp list-> ein_exp list * ein_exp*ein_exp
147 :     * filters eps and other
148 :     * stops when we find embedded summation
149 :     *)
150 :     fun filterEps eps=let
151 :     fun findeps(eps,[],rest) = (eps,rest,[])
152 :     | findeps(eps,e1::es,rest)=(case e1
153 :     of (E.Epsilon eps1) => findeps(eps@[e1],es,rest)
154 :     | E.Prod p => findeps(eps,p@es, rest)
155 :     | E.Field _ => findeps(eps,es,rest@[e1])
156 :     | E.Tensor _ => findeps(eps,es,rest@[e1])
157 :     | E.Sum(c,E.Prod(E.Epsilon eps1::ps)) => (eps,rest@es,[e1])
158 :     | _ => (eps,rest@[e1]@es,[])
159 :     (*end case*))
160 :     in
161 :     findeps([], eps,[])
162 :     end
163 : cchiw 2844
164 : cchiw 2845 (*filterSca:sum_index_is list * ein_exp-> int*ein_exp
165 :     *filter Scalars outside Summation product
166 :     *)
167 :     fun filterSca(c,e)= let
168 :     fun filter([],[],post)=(0,E.Sum(c,rewriteProd(post)))
169 :     | filter([],pre,post)=(1,rewriteProdSum(pre,c,post))
170 :     | filter(e1::es, pre,post)=(case e1
171 :     of E.Prod p => filter(p@es, pre, post)
172 :     | E.Field(_,[]) => filter(es, pre@[e1], post)
173 :     | E.Conv(_,[],_,[]) => filter(es, pre@[e1], post)
174 :     | E.Probe(E.Field(_,[]),_) => filter(es, pre@[e1], post)
175 :     | E.Probe(E.Conv(_,[],_,[]),_) => filter(es, pre@[e1], post)
176 :     | E.Tensor(id,[]) => filter(es, pre@[e1], post)
177 :     | E.Const _ => filter(es, pre@[e1], post)
178 :     | _ => filter(es,pre, post@[e1])
179 :     (*end case*))
180 :     in filter(e,[],[])
181 :     end
182 :     end
183 : cchiw 2844
184 :    
185 : cchiw 2845 end (* local *)

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