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

SCM Repository

[diderot] Diff of /branches/vis12/src/compiler/high-il/normalize.sml
ViewVC logotype

Diff of /branches/vis12/src/compiler/high-il/normalize.sml

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

revision 2164, Fri Feb 22 22:44:05 2013 UTC revision 2165, Fri Feb 22 22:44:32 2013 UTC
# Line 13  Line 13 
13      structure IL = HighIL      structure IL = HighIL
14      structure Op = HighOps      structure Op = HighOps
15      structure V = IL.Var      structure V = IL.Var
16        structure Ty = HighILTypes
17      structure ST = Stats      structure ST = Stats
18    
19    (********** Counters for statistics **********)    (********** Counters for statistics **********)
# Line 37  Line 38 
38    (* adjust a variable's use count *)    (* adjust a variable's use count *)
39      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
40      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
41        fun use x = (incUse x; x)
42    
43      fun getRHS x = (case V.binding x      fun getRHS x = (case V.binding x
44             of IL.VB_RHS(IL.OP arg) => SOME arg             of IL.VB_RHS(IL.OP arg) => SOME arg
# Line 44  Line 46 
46              | _ => NONE              | _ => NONE
47            (* end case *))            (* end case *))
48    
49      (* get the binding of a kernel variable *)
50        fun getKernelRHS h = (case getRHS h
51               of SOME(Op.Kernel(kernel, k), []) => (kernel, k)
52                | _ => raise Fail(concat[
53                      "bogus kernel binding ", V.toString h, " = ", IL.vbToString(V.binding h)
54                    ])
55              (* end case *))
56    
57    (* optimize the rhs of an assignment, returning NONE if there is no change *)    (* optimize the rhs of an assignment, returning NONE if there is no change *)
58      fun doRHS (lhs, IL.OP rhs) = (case rhs      fun doRHS (lhs, IL.OP rhs) = (case rhs
59             of (Op.Probe(domTy, rngTy), [f, pos]) => (case getRHS f             of (Op.Probe(domTy, rngTy), [f, pos]) => (case getRHS f
# Line 100  Line 110 
110                              (lhs, IL.OP(Op.Neg rngTy, [lhs']))                              (lhs, IL.OP(Op.Neg rngTy, [lhs']))
111                            ]                            ]
112                        end                        end
113                      | SOME(Op.CurlField 2, [f']) => (case getRHS f'
114                           of SOME(Op.Field dim, [v, h]) => let
115                              (* rewrite to (D f')@pos[1,0] - (D f')@pos[0,1] *)
116                                val (kernel, k) = getKernelRHS h
117                                val h' = IL.Var.copy h
118                                val f'' = IL.Var.copy f'
119                                val mat22 = Ty.TensorTy[2,2]
120                                val m = IL.Var.new("m", mat22)
121                                val zero = IL.Var.new("zero", Ty.intTy)
122                                val one = IL.Var.new("one", Ty.intTy)
123                                val m10 = IL.Var.new("m_10", Ty.realTy)
124                                val m01 = IL.Var.new("m_01", Ty.realTy)
125                                in
126                                  decUse f;
127                                  SOME[
128                                      (h', IL.OP(Op.Kernel(kernel, k+1), [])),
129                                      (f'', IL.OP(Op.Field dim, [use v, use h'])),
130                                      (m, IL.OP(Op.Probe(domTy, mat22), [use f'', pos])),
131                                      (zero, IL.LIT(Literal.Int 0)),
132                                      (one, IL.LIT(Literal.Int 1)),
133                                      (m10, IL.OP(Op.TensorSub mat22, [use m, use one, use zero])),
134                                      (m01, IL.OP(Op.TensorSub mat22, [use m, use zero, use one])),
135                                      (lhs, IL.OP(Op.Sub Ty.realTy, [use m10, use m01]))
136                                    ]
137                                end
138                            | _ => raise Fail(concat[
139                                  "bogus field binding ", V.toString f', " = ", IL.vbToString(V.binding f')
140                                ])
141                          (* end case *))
142                      | SOME(Op.CurlField 3, [f']) => (case getRHS f'
143                           of SOME(Op.Field dim, [v, h]) => let
144                              (* rewrite to
145                               *  [ (D f')@pos[2,1] - (D f')@pos[1,2] ]
146                               *  [ (D f')@pos[0,2] - (D f')@pos[2,0] ]
147                               *  [ (D f')@pos[1,0] - (D f')@pos[0,1] ]
148                               *)
149                                val (kernel, k) = getKernelRHS h
150                                val h' = IL.Var.copy h
151                                val f'' = IL.Var.copy f'
152                                val mat33 = Ty.TensorTy[3,3]
153                                val m = IL.Var.new("m", mat33)
154                                val zero = IL.Var.new("zero", Ty.intTy)
155                                val one = IL.Var.new("one", Ty.intTy)
156                                val two = IL.Var.new("two", Ty.intTy)
157                                val m21 = IL.Var.new("m_21", Ty.realTy)
158                                val m12 = IL.Var.new("m_12", Ty.realTy)
159                                val m02 = IL.Var.new("m_02", Ty.realTy)
160                                val m20 = IL.Var.new("m_20", Ty.realTy)
161                                val m10 = IL.Var.new("m_10", Ty.realTy)
162                                val m01 = IL.Var.new("m_01", Ty.realTy)
163                                val lhs0 = IL.Var.new("lhs0", Ty.realTy)
164                                val lhs1 = IL.Var.new("lhs1", Ty.realTy)
165                                val lhs2 = IL.Var.new("lhs2", Ty.realTy)
166                                in
167                                  decUse f;
168                                  SOME[
169                                      (h', IL.OP(Op.Kernel(kernel, k+1), [])),
170                                      (f'', IL.OP(Op.Field dim, [use v, use h'])),
171                                      (m, IL.OP(Op.Probe(domTy, mat33), [use f'', pos])),
172                                      (zero, IL.LIT(Literal.Int 0)),
173                                      (one, IL.LIT(Literal.Int 1)),
174                                      (two, IL.LIT(Literal.Int 2)),
175                                      (m21, IL.OP(Op.TensorSub mat33, [use m, use two, use one])),
176                                      (m12, IL.OP(Op.TensorSub mat33, [use m, use one, use two])),
177                                      (lhs0, IL.OP(Op.Sub Ty.realTy, [use m21, use m12])),
178                                      (m02, IL.OP(Op.TensorSub mat33, [use m, use zero, use two])),
179                                      (m20, IL.OP(Op.TensorSub mat33, [use m, use two, use zero])),
180                                      (lhs1, IL.OP(Op.Sub Ty.realTy, [use m02, use m20])),
181                                      (m10, IL.OP(Op.TensorSub mat33, [use m, use one, use zero])),
182                                      (m01, IL.OP(Op.TensorSub mat33, [use m, use zero, use one])),
183                                      (lhs2, IL.OP(Op.Sub Ty.realTy, [use m10, use m01])),
184                                      (lhs, IL.CONS(Ty.TensorTy[3], [lhs0, lhs1, lhs2]))
185                                    ]
186                                end
187                            | _ => raise Fail(concat[
188                                  "bogus field binding ", V.toString f', " = ", IL.vbToString(V.binding f')
189                                ])
190                          (* end case *))
191                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
192                          "bogus field binding ", V.toString f, " = ", IL.vbToString(V.binding f)                          "bogus field binding ", V.toString f, " = ", IL.vbToString(V.binding f)
193                        ])                        ])
194                  (* end case *))                  (* end case *))
195              | (Op.DiffField, [f]) => (case (getRHS f)              | (Op.DiffField, [f]) => (case (getRHS f)
196                   of SOME(Op.Field dim, [v, h]) => (case getRHS h                   of SOME(Op.Field dim, [v, h]) => let
197                         of SOME(Op.Kernel(kernel, k), []) => let                        val (kernel, k) = getKernelRHS h
198                              val h' = IL.Var.copy h                              val h' = IL.Var.copy h
199                              in                              in
200                                ST.tick cntDiffField;                                ST.tick cntDiffField;
# Line 117  Line 205 
205                                    (lhs, IL.OP(Op.Field dim, [v, h']))                                    (lhs, IL.OP(Op.Field dim, [v, h']))
206                                  ]                                  ]
207                              end                              end
                         | _ => raise Fail(concat[  
                               "bogus kernel binding ", V.toString h, " = ", IL.vbToString(V.binding h)  
                             ])  
                       (* end case *))  
208                    | SOME(Op.AddField, [f, g]) => raise Fail "Diff(f+g)"                    | SOME(Op.AddField, [f, g]) => raise Fail "Diff(f+g)"
209                    | SOME(Op.SubField, [f, g]) => raise Fail "Diff(f-g)"                    | SOME(Op.SubField, [f, g]) => raise Fail "Diff(f-g)"
210                    | SOME(Op.ScaleField, [s, f']) => let                    | SOME(Op.ScaleField, [s, f']) => let
# Line 149  Line 233 
233                        end                        end
234                    | _ => NONE                    | _ => NONE
235                  (* end case *))                  (* end case *))
236                | (Op.CurlField _, [f]) => (case (getRHS f)
237                  (* FIXME: the following is just the constant 0 field, but we don't have
238                   * a representation of constant fields
239                   *)
240                     of SOME(Op.AddField, [f, g]) => raise Fail "curl(f+g)"
241                      | SOME(Op.SubField, [f, g]) => raise Fail "curl(f-g)"
242                      | SOME(Op.ScaleField, [s, f']) => raise Fail "curl(s*f)"
243                      | SOME(Op.NegField, [f']) => raise Fail "curl(-f)"
244                      | SOME(Op.DiffField, _) => raise Fail "curl of del"
245                      | _ => NONE
246                    (* end case *))
247              | _ => NONE              | _ => NONE
248            (* end case *))            (* end case *))
249        | doRHS _ = NONE        | doRHS _ = NONE

Legend:
Removed from v.2164  
changed lines
  Added in v.2165

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