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
 [diderot] / branches / charisee / src / compiler / high-il / filter-ein.sml

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

Revision 2845 - (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 : of [] => (1,E.Const(1)) 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 : | _ => filter(es,pre, post@[e1]) 133 : (*end case*)) 134 : in filter(e,[],[]) 135 : end 136 : 137 : (*filterPartial:ein_exp list-> mu list 138 : * peels mu in partial expression 139 : *) 140 : fun filterPartial([])=[] 141 : | filterPartial(E.Partial d1::es)=d1@filterPartial(es) 142 : | filterPartial _= err"Found non-Partial in Apply" 143 : cchiw 2844 144 : 145 : cchiw 2845 (*filterEps:ein_exp list-> ein_exp list * ein_exp*ein_exp 146 : * filters eps and other 147 : * stops when we find embedded summation 148 : *) 149 : fun filterEps eps=let 150 : fun findeps(eps,[],rest) = (eps,rest,[]) 151 : | findeps(eps,e1::es,rest)=(case e1 152 : of (E.Epsilon eps1) => findeps(eps@[e1],es,rest) 153 : | E.Prod p => findeps(eps,p@es, rest) 154 : | E.Field _ => findeps(eps,es,rest@[e1]) 155 : | E.Tensor _ => findeps(eps,es,rest@[e1]) 156 : | E.Sum(c,E.Prod(E.Epsilon eps1::ps)) => (eps,rest@es,[e1]) 157 : | _ => (eps,rest@[e1]@es,[]) 158 : (*end case*)) 159 : in 160 : findeps([], eps,[]) 161 : end 162 : cchiw 2844 163 : cchiw 2845 (*filterSca:sum_index_is list * ein_exp-> int*ein_exp 164 : *filter Scalars outside Summation product 165 : *) 166 : fun filterSca(c,e)= let 167 : fun filter([],[],post)=(0,E.Sum(c,rewriteProd(post))) 168 : | filter([],pre,post)=(1,rewriteProdSum(pre,c,post)) 169 : | filter(e1::es, pre,post)=(case e1 170 : of E.Prod p => filter(p@es, pre, post) 171 : | E.Field(_,[]) => filter(es, pre@[e1], post) 172 : | E.Conv(_,[],_,[]) => filter(es, pre@[e1], post) 173 : | E.Probe(E.Field(_,[]),_) => filter(es, pre@[e1], post) 174 : | E.Probe(E.Conv(_,[],_,[]),_) => filter(es, pre@[e1], post) 175 : | E.Tensor(id,[]) => filter(es, pre@[e1], post) 176 : | E.Const _ => filter(es, pre@[e1], post) 177 : | _ => filter(es,pre, post@[e1]) 178 : (*end case*)) 179 : in filter(e,[],[]) 180 : end 181 : end 182 : cchiw 2844 183 : 184 : cchiw 2845 end (* local *)

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