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

SCM Repository

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

Diff of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml

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

trunk/src/compiler/high-to-mid/high-to-mid.sml revision 365, Wed Sep 29 20:07:58 2010 UTC branches/vis12/src/compiler/high-to-mid/high-to-mid.sml revision 1922, Sat Jun 23 11:25:39 2012 UTC
# Line 1  Line 1 
1  (* high-to-mid.sml  (* high-to-mid.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Translation from HighIL to MidIL representations.   * Translation from HighIL to MidIL representations.
# Line 13  Line 13 
13    end = struct    end = struct
14    
15      structure SrcIL = HighIL      structure SrcIL = HighIL
16        structure SrcTy = HighILTypes
17      structure SrcOp = HighOps      structure SrcOp = HighOps
18        structure SrcSV = SrcIL.StateVar
19      structure VTbl = SrcIL.Var.Tbl      structure VTbl = SrcIL.Var.Tbl
20      structure DstIL = MidIL      structure DstIL = MidIL
21        structure DstTy = MidILTypes
22      structure DstOp = MidOps      structure DstOp = MidOps
23    
24      type var_env = DstIL.var SrcIL.Var.Tbl.hash_table      fun getRHS x  = (case SrcIL.Var.binding x
25               of SrcIL.VB_RHS(SrcIL.OP(rator, args)) => (rator, args)
26                | SrcIL.VB_RHS(SrcIL.VAR x') => getRHS x'
27                | vb => raise Fail(concat[
28                      "expected rhs operator for ", SrcIL.Var.toString x,
29                      "but found ", SrcIL.vbToString vb
30                    ])
31              (* end case *))
32    
33        fun cvtTy SrcTy.BoolTy = DstTy.BoolTy
34          | cvtTy SrcTy.StringTy = DstTy.StringTy
35          | cvtTy SrcTy.IntTy = DstTy.intTy
36          | cvtTy (SrcTy.TensorTy dd) = DstTy.tensorTy dd
37          | cvtTy (SrcTy.TupleTy tys) = DstTy.TupleTy(List.map cvtTy tys)
38          | cvtTy (SrcTy.SeqTy(ty, n)) = DstTy.SeqTy(cvtTy ty, n)
39          | cvtTy (SrcTy.DynSeqTy ty) = DstTy.DynSeqTy(cvtTy ty)
40        (* we replace Kernel and Field operations by 0, so the types are mapped to int *)
41          | cvtTy SrcTy.KernelTy = DstTy.intTy
42          | cvtTy SrcTy.FieldTy = DstTy.intTy
43          | cvtTy ty = raise Fail("unexpected type " ^ SrcTy.toString ty)
44    
45      (* instantiate the translation environment *)
46        local
47          type var_env = DstIL.var VTbl.hash_table
48          type state_var_env = DstIL.state_var SrcSV.Tbl.hash_table
49    
50      fun rename (env : var_env, x) = (case VTbl.find env x      fun rename (env : var_env, x) = (case VTbl.find env x
51             of SOME x' => x'             of SOME x' => x'
52              | NONE => let              | NONE => let
53                  val x' = DstIL.Var.new (SrcIL.Var.name x)                    val dstTy = (case SrcIL.Var.ty x
54                             of SrcTy.ImageTy _ => (
55                                (* for variables with image type, we need more detailed information
56                                 * about the image for the MidIL type.
57                                 *)
58                                  case getRHS x
59                                   of (SrcOp.LoadImage v, _) => DstTy.ImageTy v
60                                    | _ => raise Fail "bogus image variable"
61                                  (* end case *))
62                              | _ => cvtTy(SrcIL.Var.ty x)
63                            (* end case *))
64                      val x' = DstIL.Var.new (SrcIL.Var.name x, dstTy)
65                  in                  in
66                    VTbl.insert env (x, x');                    VTbl.insert env (x, x');
67                    x'                    x'
68                  end                  end
69            (* end case *))            (* end case *))
70    handle Fail msg => raise Fail(concat["rename(_, ", SrcIL.Var.toString x, "): ", msg])
71    
72    (* expand the field Inside operator into a image-space test *)          fun renameSV (env : state_var_env, x) = (case SrcSV.Tbl.find env x
73      fun expandInside (env, result, pos, fld) = let                 of SOME x' => x'
74            val pos = rename (env, pos)                  | NONE => let
75            val fld = (case SrcIL.Var.binding fld                      val dstTy = cvtTy (SrcSV.ty x)
76                   of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld                      val x' = DstIL.StateVar.new (SrcSV.isOutput x, SrcSV.name x, dstTy)
77                    | _ => raise Fail "bogus field binding"                      in
78                          SrcSV.Tbl.insert env (x, x');
79                          x'
80                        end
81                  (* end case *))
82        in
83        structure Env = TranslateEnvFn (
84          struct
85            structure SrcIL = SrcIL
86            structure DstIL = DstIL
87            type var_env = var_env
88            type state_var_env = state_var_env
89            val rename = rename
90            val renameSV = renameSV
91          end)
92        end
93    
94      (* expand raising a real to an integer power.  When we know the exponent, we can inline
95       * multiplications.
96       *)
97        fun expandPower (env, y, [x, n]) = let
98              fun getConst x = (case SrcIL.Var.binding x
99                     of SrcIL.VB_RHS(SrcIL.VAR x') => getConst x'
100                      | SrcIL.VB_RHS(SrcIL.LIT(Literal.Int n)) => SOME n
101                      | vb => NONE
102                  (* end case *))                  (* end case *))
103            fun expand (FieldDef.CONV(_, img, _)) = let            val x = Env.rename(env, x)
104                  val imgPos = DstIL.Var.new "x"            fun pow () = let
105                    val t = DstIL.Var.new("n", DstTy.realTy)
106                  in [                  in [
107                    (imgPos, DstIL.OP(DstOp.Transform img, [pos])),                    (t, DstIL.OP(DstOp.IntToReal, [Env.rename(env, n)])),
108                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))                    (y, DstIL.APPLY(MathFuns.pow, [x, t]))
109                  ] end                  ] end
             | expand (FieldDef.NEG fld) = expand fld  
             | expand (FieldDef.SUM(fld1, dlf2)) = raise Fail "expandInside: SUM"  
110            in            in
111              expand fld              case getConst n
112                 of SOME 0 => [(y, DstIL.LIT(Literal.Float(FloatLit.one)))]
113                  | SOME 1 => [(y, DstIL.VAR x)]
114                  | SOME ~1 => let
115                      val t = DstIL.Var.new("one", DstTy.realTy)
116                      in [
117                        (t, DstIL.LIT(Literal.Float(FloatLit.one))),
118                        (y, DstIL.OP(DstOp.Div DstTy.realTy, [t, x]))
119                      ] end
120                  | SOME 2 => [(y, DstIL.OP(DstOp.Mul DstTy.realTy, [x, x]))]
121    (* FIXME: expand into multiplications; ~2 ==> sqrt
122                  | SOME n =>
123    *) | SOME _ => pow()
124                  | NONE => pow()
125            end            end
126    
127      fun expandProbe (env, result, fld, pos) = let    (* expand the field Inside operator into a image-space test *)
128            val pos = rename (env, pos)      fun expandInside (env, result, pos, fld) = (case getRHS fld
129            val fld = (case SrcIL.Var.binding fld             of (SrcOp.Field d, [img, h]) => (case (getRHS img, getRHS h)
130                   of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld                   of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, _), [])) => let
131                          val pos = Env.rename (env, pos)
132                          val img = Env.rename (env, img)
133                          val imgPos = DstIL.Var.new ("x", DstTy.vecTy d)
134                          val s = Kernel.support h
135                          in [
136                            (imgPos, DstIL.OP(DstOp.PosToImgSpace v, [img, pos])),
137                            (result, DstIL.OP(DstOp.Inside(v, s), [imgPos, img]))
138                          ] end
139                      | _ => raise Fail "bogus kernel binding"
140                    (* end case *))
141                | _ => raise Fail "bogus field binding"
142              (* end case *))
143    
144        fun expandProbe (env, result, fld, pos) = (case getRHS fld
145               of (SrcOp.Field _, [img, h]) => (case (getRHS img, getRHS h)
146                     of ((SrcOp.LoadImage v, _), (SrcOp.Kernel(h, k), _)) => Probe.expand {
147                            result = result,
148                            img = Env.rename (env, img),
149                            v = v, h = h, k = k,
150                            pos = Env.rename (env, pos)
151                          }
152                      | _ => raise Fail "bogus image/kernel binding"
153                    (* end case *))
154                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
155                  (* end case *))                  (* end case *))
156    
157      (* expand the outer product of vectors v1 and v2, with dimensions d1 and d2 (resp.) *)
158        fun expandOuter (env, y, d1, d2, v1, v2) = let
159              val rowTy = DstTy.tensorTy[d1]
160              val colTy = DstTy.tensorTy[d2]
161              fun mkVar (i, j) = DstIL.Var.new (concat["o_", Int.toString i, "_", Int.toString j], DstTy.realTy)
162              fun mkRowVar i = DstIL.Var.new ("r_" ^ Int.toString i, DstTy.TensorTy[d2])
163              fun rowLp (i, rowVars, code) = if (i < d1)
164                    then let
165                      fun colLp (j, colVars, code) = if (j < d2)
166                            then let
167                              val a = DstIL.Var.new("a", DstTy.realTy)
168                              val b = DstIL.Var.new("b", DstTy.realTy)
169                              val x = mkVar (i, j)
170                              val code = (x, DstIL.OP(DstOp.Mul DstTy.realTy, [a, b]))
171                                    :: (b, DstIL.OP(DstOp.Index(colTy, j), [v2]))
172                                    :: (a, DstIL.OP(DstOp.Index(rowTy, i), [v1]))
173                                    :: code
174            in            in
175              Probe.expand (result, fld, pos)                              colLp (j+1, x::colVars, code)
176                              end
177                            else let
178                              val r = mkRowVar i
179                              in
180                                rowLp (i+1, r::rowVars,
181                                  (r, DstIL.CONS(rowTy, List.rev colVars)) :: code)
182                              end
183                      in
184                        colLp (0, [], code)
185                      end
186                    else List.rev ((y, DstIL.CONS(DstTy.TensorTy[d1,d2], List.rev rowVars)) :: code)
187              in
188                rowLp (0, [], [])
189            end            end
190    
191      fun cvtTy SrcOp.BoolTy = DstOp.BoolTy      fun arity (SrcTy.TensorTy[]) = 1
192        | cvtTy SrcOp.StringTy = DstOp.StringTy        | arity (SrcTy.TensorTy[d]) = d
       | cvtTy SrcOp.IntTy = DstOp.IntTy  
       | cvtTy (SrcOp.TensorTy[]) = DstOp.realTy  
       | cvtTy (SrcOp.TensorTy[d]) = DstOp.VecTy d  
       | cvtTy _ = raise Fail "unexpected higher-order tensor type"  
   
     fun arity (SrcOp.TensorTy[]) = 1  
       | arity (SrcOp.TensorTy[d]) = d  
193        | arity _ = raise Fail "arity"        | arity _ = raise Fail "arity"
194    
195      fun expandOp (env, y, rator, args) = let      fun expandOp (env, y, rator, args) = let
196            fun assign rator' =            fun assign rator' =
197                  [(y, DstIL.OP(rator', List.map (fn x => rename(env, x)) args))]                  [(y, DstIL.OP(rator', Env.renameList(env, args)))]
198              fun cvtToInt rator' = let
199                    val t = DstIL.Var.new ("t", DstTy.realTy)
200                    in [
201                      (t, DstIL.OP(rator', Env.renameList(env, args))),
202                      (y, DstIL.OP(DstOp.RealToInt 1, [t]))
203                    ] end
204              fun dummy () = [(y, DstIL.LIT(Literal.Int 0))]
205            in            in
206              case rator              case rator
207               of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))               of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
# Line 80  Line 209 
209                | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))                | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
210                | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))                | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
211                | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))                | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
212                  | SrcOp.Abs ty => assign (DstOp.Abs(cvtTy ty))
213                | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))                | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
214                | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))                | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
215                | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))                | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
216                | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))                | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
217                | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))                | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
218                | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))                | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
219                  | SrcOp.Power => expandPower(env, y, args)
220                  | SrcOp.Not => assign DstOp.Not
221                  | SrcOp.Max => assign DstOp.Max
222                  | SrcOp.Min => assign DstOp.Min
223                  | SrcOp.Clamp ty => assign (DstOp.Clamp(cvtTy ty))
224                  | SrcOp.Lerp ty => assign (DstOp.Lerp(cvtTy ty))
225                | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))                | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
226                  | SrcOp.MulVecMat(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulVecMat(d1, d2))
227                  | SrcOp.MulMatVec(SrcTy.TensorTy[d1, d2]) => assign (DstOp.MulMatVec(d1, d2))
228                  | SrcOp.MulMatMat(SrcTy.TensorTy[d1, d2], SrcTy.TensorTy[d2', d3]) =>
229                      assign (DstOp.MulMatMat(d1, d2, d3))
230                | SrcOp.Cross => assign DstOp.Cross                | SrcOp.Cross => assign DstOp.Cross
231                | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))                | SrcOp.Outer(SrcTy.TensorTy[d1, d2]) => let
232                | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))                    val [v1, v2] = Env.renameList(env, args)
233                | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))                    in
234                | SrcOp.CL => assign DstOp.CL                      expandOuter (env, y, d1, d2, v1, v2)
235                      end
236                  | SrcOp.Norm ty => assign (DstOp.Norm(cvtTy ty))
237                  | SrcOp.Normalize ty => assign (DstOp.Normalize(arity ty))
238                  | SrcOp.Scale ty => assign (DstOp.Scale(cvtTy ty))
239                | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))                | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
240                | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))                | SrcOp.Identity n => assign (DstOp.Identity n)
241                | SrcOp.Max => assign DstOp.Max                | SrcOp.Zero ty => assign (DstOp.Zero(cvtTy ty))
242                | SrcOp.Min => assign DstOp.Min                | SrcOp.Trace(SrcTy.TensorTy[d, _]) => assign (DstOp.Trace d)
243                | SrcOp.Sin => assign DstOp.Sin                | SrcOp.Slice(ty, mask) => raise Fail "FIXME: Slice"
244                | SrcOp.Cos => assign DstOp.Cos                | SrcOp.TensorSub(ty as SrcTy.TensorTy _) => assign (DstOp.Subscript(cvtTy ty))
245                | SrcOp.Pow => assign DstOp.Pow                | SrcOp.Select(ty as SrcTy.TupleTy _, i) => assign (DstOp.Select(cvtTy ty, i))
246                | SrcOp.Not => assign DstOp.Not                | SrcOp.Select(ty as SrcTy.SeqTy _, i) => assign (DstOp.Index(cvtTy ty, i))
247                  | SrcOp.SeqSub(ty as SrcTy.SeqTy _) => assign (DstOp.Subscript(cvtTy ty))
248                  | SrcOp.MkDynamic(ty, n) => assign (DstOp.MkDynamic(cvtTy ty, n))
249                  | SrcOp.Append ty => assign (DstOp.Append(cvtTy ty))
250                  | SrcOp.Prepend ty => assign (DstOp.Prepend(cvtTy ty))
251                  | SrcOp.Concat ty => assign (DstOp.Concat(cvtTy ty))
252                | SrcOp.IntToReal => assign DstOp.IntToReal                | SrcOp.IntToReal => assign DstOp.IntToReal
253                | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)                | SrcOp.TruncToInt => cvtToInt (DstOp.Trunc 1)
254                | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)                | SrcOp.RoundToInt => cvtToInt (DstOp.Round 1)
255                | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)                | SrcOp.CeilToInt => cvtToInt (DstOp.Ceiling 1)
256                | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)                | SrcOp.FloorToInt => cvtToInt (DstOp.Floor 1)
257                  | SrcOp.Kernel _ => dummy()
258                | SrcOp.LoadImage info => assign (DstOp.LoadImage info)                | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
259                | SrcOp.Inside => (case args                | SrcOp.Inside _ => (case args
260                     of [pos, fld] => expandInside(env, y, pos, fld)                     of [pos, fld] => expandInside(env, y, pos, fld)
261                    (* end case *))                    (* end case *))
262  (* QUESTION: there is no MidIL equivalant, but these might be floating                | SrcOp.Probe _ => (case args
  * around, which could cause invalid MidIL to be generated.  
  *)  
               | SrcOp.Field fld => []  
               | SrcOp.Probe => (case args  
263                     of [fld, pos] => expandProbe(env, y, fld, pos)                     of [fld, pos] => expandProbe(env, y, fld, pos)
264                    (* end case *))                    (* end case *))
265                | SrcOp.Input s => assign (DstOp.Input s)              (* fields are used in the Inside and Probe operations, but are otherwise ignored *)
266                | SrcOp.InputWithDefault s => assign (DstOp.InputWithDefault s)                | SrcOp.Field _ => dummy()
267                | _ => raise Fail("unexpected " ^ SrcOp.toString rator)                | SrcOp.AddField => dummy()
268                  | SrcOp.SubField => dummy()
269                  | SrcOp.ScaleField => dummy()
270                  | SrcOp.NegField => dummy()
271                  | SrcOp.DiffField => dummy()
272                  | SrcOp.Input(ty, s, desc) => assign (DstOp.Input(cvtTy ty, s, desc))
273                  | SrcOp.InputWithDefault(ty, s, desc) =>
274                      assign (DstOp.InputWithDefault(cvtTy ty, s, desc))
275                  | rator => raise Fail("bogus operator " ^ SrcOp.toString rator)
276              (* end case *)              (* end case *)
277            end            end
278    
279      (* expand a SrcIL assignment to a list of DstIL assignments *)
280      fun expand (env, (y, rhs)) = let      fun expand (env, (y, rhs)) = let
281            val y' = rename (env, y)            fun assign rhs = [DstIL.ASSGN(Env.rename (env, y), rhs)]
           fun assign rhs = [(y', rhs)]  
282            in            in
283              case rhs              case rhs
284               of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))               of SrcIL.STATE x => assign (DstIL.STATE(Env.renameSV(env, x)))
285                  | SrcIL.VAR x => assign (DstIL.VAR(Env.rename(env, x)))
286                | SrcIL.LIT lit => assign (DstIL.LIT lit)                | SrcIL.LIT lit => assign (DstIL.LIT lit)
287                  | SrcIL.OP(SrcOp.Field _, args) => []
288                | SrcIL.OP(rator, args) =>                | SrcIL.OP(rator, args) =>
289                    expandOp (env, y', rator, args)                    List.map DstIL.ASSGN (expandOp (env, Env.rename (env, y), rator, args))
290                | SrcIL.CONS args =>                | SrcIL.APPLY(f, args) => assign(DstIL.APPLY(f, Env.renameList(env, args)))
291                    assign (DstIL.CONS(List.map (fn x => rename(env, x)) args))                | SrcIL.CONS(ty, args) => assign (DstIL.CONS(cvtTy ty, Env.renameList(env, args)))
292              (* end case *)              (* end case *)
293            end            end
294    
295      (* expand a SrcIL multi-assignment to a DstIL CFG *)
296        fun mexpand (env, (ys, rator, xs)) = let
297              val ys' = Env.renameList(env, ys)
298              val rator' = (case rator
299                     of SrcOp.Eigen2x2 => DstOp.EigenVecs2x2
300                      | SrcOp.Eigen3x3 => DstOp.EigenVecs3x3
301                      | SrcOp.Print tys => DstOp.Print(List.map cvtTy tys)
302                      | _ => raise Fail("bogus operator " ^ SrcOp.toString rator)
303                    (* end case *))
304              val xs' = Env.renameList(env, xs)
305              val nd = DstIL.Node.mkMASSIGN(ys', rator', xs')
306              in
307                DstIL.CFG{entry=nd, exit=nd}
308              end
309    
310      structure Trans =  TranslateFn (      structure Trans =  TranslateFn (
311        struct        struct
312          structure SrcIL = SrcIL          open Env
313          structure DstIL = DstIL          val expand = DstIL.CFG.mkBlock o expand
314            val mexpand = mexpand
         type var_env = var_env  
   
         val rename = rename  
         val expand = expand  
315        end)        end)
316    
317      fun translate (SrcIL.Program{globals, globalInit, actors}) =      fun translate prog = let
318            raise Fail "unimplemented"            val prog = Trans.translate prog
319              in
320                MidILCensus.init prog;
321                prog
322              end
323    
324    end    end

Legend:
Removed from v.365  
changed lines
  Added in v.1922

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