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

SCM Repository

[diderot] Diff of /trunk/src/compiler/translate/translate.sml
ViewVC logotype

Diff of /trunk/src/compiler/translate/translate.sml

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

revision 190, Sat Jul 31 04:39:18 2010 UTC revision 426, Mon Oct 18 18:49:55 2010 UTC
# Line 13  Line 13 
13    end = struct    end = struct
14    
15      structure S = Simple      structure S = Simple
16        structure Ty = Types
17      structure VMap = Var.Map      structure VMap = Var.Map
18      structure VSet = Var.Set      structure VSet = Var.Set
19      structure IL = HighIL      structure IL = HighIL
20        structure DstTy = HighILTypes
21    
22      fun lookup env x = (case VMap.find x      fun lookup env x = (case VMap.find (env, x)
23             of SOME x' => x'             of SOME x' => x'
24              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
25                    "no binding for ", Var.toString x, " in environment"                    "no binding for ", Var.uniqueNameOf x, " in environment"
26                  ])                  ])
27            (* end case *))            (* end case *))
28    
29        fun cvtTy ty = (case TypeUtil.prune ty
30               of Ty.T_Bool => DstTy.BoolTy
31                | Ty.T_Int => DstTy.IntTy
32                | Ty.T_String => DstTy.StringTy
33                | Ty.T_Kernel _ => DstTy.KernelTy
34                | Ty.T_Tensor(Ty.Shape dd) => let
35                    fun cvtDim (Ty.DimConst 1) = NONE
36                      | cvtDim (Ty.DimConst d) = SOME d
37                    in
38                      DstTy.TensorTy(List.mapPartial cvtDim dd)
39                    end
40                | Ty.T_Image _ => DstTy.ImageTy
41                | Ty.T_Field _ => DstTy.FieldTy
42                | ty => raise Fail("cvtTy: unexpected " ^ TypeUtil.toString ty)
43              (* end case *))
44    
45    (* create a new instance of a variable *)    (* create a new instance of a variable *)
46      fun newVar x = IL.newVar (Var.nameOf x)      fun newVar x = IL.Var.new (Var.nameOf x, cvtTy(Var.monoTypeOf x))
47    
48    (* expression translation *)    (* expression translation *)
49      fun cvtExpr (env, lhs, exp) = (case exp      fun cvtExp (env, lhs, exp) = (case exp
50             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
51              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [(lhs, IL.LIT lit)]
52              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
# Line 38  Line 56 
56                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
57                  end                  end
58              | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]              | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
59                | S.E_Slice(x, indices, ty) => let
60                    val x = lookup env x
61                    val mask = List.map isSome indices
62                    fun cvt NONE = NONE
63                      | cvt (SOME x) = SOME(lookup env x)
64                    val indices = List.mapPartial cvt indices
65                    in
66                      if List.all (fn b => b) mask
67                        then [(lhs, IL.OP(HighOps.Subscript(IL.Var.ty x), x::indices))]
68                        else [(lhs, IL.OP(HighOps.Slice(IL.Var.ty lhs, mask), x::indices))]
69                    end
70                | S.E_Input(_, name, NONE) =>
71                    [(lhs, IL.OP(HighOps.Input(IL.Var.ty lhs, name), []))]
72                | S.E_Input(_, name, SOME dflt) =>
73                    [(lhs, IL.OP(HighOps.InputWithDefault(IL.Var.ty lhs, name), [lookup env dflt]))]
74                | S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]
75                | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
76            (* end case *))            (* end case *))
77    
78      fun cvtBlock (env, S.Block stms) =    (* convert a Simple AST block to an IL statement.  We return the statement that represents the
79       * block, plus the environment mapping Simple AST variables to their current SSA representations
80    (* convert a statement, where env is the mapping from Simple AST variables to     * and the set of Simple AST variables that were assigned to in the block.
    * their current SSA name, assigned is the set of AST variables assigned to  
    * in the current context, and stm is the statement to convert.  
81     *)     *)
82      and cvtStmt (env, assigned, stm, preStms, k) = (case stm      fun cvtBlock (env, S.Block stms, optExit) = let
83             of S.S_Assign(x, e) => let            fun toBlock (env, assigned, [], assignments) = let
84                    val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)
85                    in
86                      (stm, IL.Stmt.tail stm, env, assigned)
87                    end
88                | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
89                  val x' = newVar x                  val x' = newVar x
90                  val stms = cvtExp(env, x', e)                  val stms = cvtExp(env, x', e)
91                  val assigned = VSet.add(assigned, x)                  val assigned = VSet.add(assigned, x)
92                  val env = VMap.insert(env, x, x')                  val env = VMap.insert(env, x, x')
93                  in                  in
94                    k (env, assigned, stm::preStms)                    toBlock (env, assigned, rest, stms@assignments)
95                    end
96                | toBlock (env, assigned, stms, assignments) = let
97                    val (next, last, env, assigned) = toStmt (env, assigned, stms)
98                    val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)
99                    in
100                      IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);
101                      (blk, last, env, assigned)
102                  end                  end
103              and toStmt (env, assigned, []) = let
104                  (* this case only occurs for the empty else arm of an if-then-else statement *)
105                    val stm = IL.Stmt.mkBLOCK([], optExit)
106                    in
107                      (stm, IL.Stmt.tail stm, env, assigned)
108                    end
109                | toStmt (env, assigned, stms as stm::rest) = (case stm
110                     of S.S_Assign _ => toBlock (env, assigned, stms, [])
111              | S.S_IfThenElse(x, b1, b2) => let              | S.S_IfThenElse(x, b1, b2) => let
112                  val x' = lookup env x                  val x' = lookup env x
113                  val (b1, env1, assigned1) = block(env, b1)                        val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)
114                  val (b2, env2, assigned2) = block(env, b2)                        val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)
115                  val assigned = VSet.union(assigned1, assigned2)                  val assigned = VSet.union(assigned1, assigned2)
116    (* PROBLEM: what about variables that are assigned for the first time in one branch
117     * and not the other?  This situation should only occur for variables who's scope is
118     * the branch of the if.  Short-term solution is to ignore variables that are defined
119     * in only one branch.
120     *)
121                  val (env, phis) = let                  val (env, phis) = let
122                        fun mkPhi (x, (env, phis) = let                              fun mkPhi (x, (env, phis)) = (
123                              val x1 = lookup(env1, x)                                    case (VMap.find(env1, x), VMap.find(env2, x))
124                              val x2 = lookup(env2, x)                                     of (SOME x1, SOME x2) => let
125                              val x' = newVar x                              val x' = newVar x
126                              in                              in
127                                (VMap.insert(env, x, x'), (x', [x1, x2])::phis)                                (VMap.insert(env, x, x'), (x', [x1, x2])::phis)
128                              end                              end
129                                        | _ => (env, phis)
130                                      (* end case *))
131                        in                        in
132                          VSet.foldl mkPhi (env, []) assigned                          VSet.foldl mkPhi (env, []) assigned
133                        end                        end
134                  in                  in
135                            case rest
136                             of [] => let
137                                  val join = IL.Stmt.mkJOIN (phis, optExit)
138                                  val joinNd = IL.Stmt.entry join
139                                  val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
140                                  in
141                                    IL.Node.addEdge (last2, joinNd);
142                                    IL.Node.addEdge (last1, joinNd);
143                                    (stm, joinNd, env, assigned)
144                                  end
145                              | _ => let
146                                  val (next, last, env, assigned) = toStmt (env, assigned, rest)
147                                  val join = IL.Stmt.mkJOIN (phis, SOME next)
148                                  val joinNd = IL.Stmt.entry join
149                                  val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
150                                  in
151                                    IL.Node.addEdge (last2, joinNd);
152                                    IL.Node.addEdge (last1, joinNd);
153                                    IL.Node.addEdge (joinNd, IL.Stmt.entry next);
154                                    (stm, last, env, assigned)
155                                  end
156                            (* end case *)
157                          end
158                      | S.S_New(name, xs) => let
159                          val xs' = List.map (lookup env) xs
160                          in
161                            case rest
162                             of [] => let
163                                  val stm = IL.Stmt.mkNEW(name, xs', optExit)
164                                  in
165                                    (stm, IL.Stmt.tail stm, env, assigned)
166                                  end
167                              | _ => let
168                                  val (next, last, env, assigned) = toStmt (env, assigned, rest)
169                                  val stm = IL.Stmt.mkNEW(name, xs', SOME next)
170                                  in
171                                    IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);
172                                    (stm, last, env, assigned)
173                                  end
174                          end
175                      | S.S_Die => let
176                          val stm = IL.Stmt.mkDIE()
177                          in
178                            (stm, IL.Stmt.tail stm, env, assigned)
179                          end
180                      | S.S_Stabilize => let
181                          val stm = IL.Stmt.mkSTABILIZE()
182                          in
183                            (stm, IL.Stmt.tail stm, env, assigned)
184                  end                  end
             | S.S_New(name, xs) =>  
             | S.S_Die =>  
             | S.S_Stabilize =>  
185            (* end case *))            (* end case *))
186              in
187                toStmt (env, VSet.empty, stms)
188              end
189    
190      fun newBlock (??, stm) =      fun cvtTopLevelBlock (env, blk) = let
191              val exit = IL.Stmt.mkEXIT ()
192              val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)
193              val entry = IL.Stmt.mkENTRY (SOME stm)
194              in
195                IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);
196              (* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we
197               * wrap it in a handler
198               *)
199                IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();
200                (entry, env)
201              end
202    
203      and nextStmt (env, assigned, stm, ??) =    (* generate fresh SSA variables and add them to the environment *)
204        fun freshVars (env, xs) = let
205              fun cvtVar (x, (env, xs)) = let
206                    val x' = newVar x
207                    in
208                      (VMap.insert(env, x, x'), x'::xs)
209                    end
210              val (env, xs) = List.foldl cvtVar (env, []) xs
211              in
212                (env, List.rev xs)
213              end
214    
215      and join (env      fun translate (S.Program{globals, globalInit, actors}) = let
216      fun translate (S.Program{globals, globaInit, actors}) = ??            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
217            (* get the SSA names for the globals and a reduced environment that just defines
218             * the globals.
219             *)
220              val (env, globs) = let
221                    val lookup = lookup env
222                    fun cvtVar (x, (env, globs)) = let
223                          val x' = lookup x
224                          in
225                            (VMap.insert(env, x, x'), x'::globs)
226                          end
227                    val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
228                    in
229                      (env, List.rev globs)
230                    end
231              fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let
232                    val (env, params) = let
233                          fun cvtParam (x, (env, xs)) = let
234                                val x' = newVar x
235                                in
236                                  (VMap.insert(env, x, x'), x'::xs)
237                                end
238                          val (env, params) = List.foldl cvtParam (env, []) params
239                          in
240                            (env, List.rev params)
241                          end
242                    val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
243                    val state' = List.map (lookup env) state
244                    fun cvtMethod (S.Method(name, blk)) = let
245                        (* allocate fresh variables for the state variables *)
246                          val (env, stateIn) = freshVars (env, state)
247                          val (body, env) = cvtTopLevelBlock (env, blk)
248                          val stateOut = List.map (lookup env) state
249                          in
250                            IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}
251                          end
252                    in
253                      IL.Actor{
254                          name = name,
255                          params = params,
256                          state = state',
257                          stateInit = stateInit,
258                          methods = List.map cvtMethod methods
259                        }
260                    end
261              in
262                IL.Program{
263                    globals = globs,
264                    globalInit = globalInit,
265                    actors = List.map cvtActor actors
266                  }
267              end
268    
269    end    end

Legend:
Removed from v.190  
changed lines
  Added in v.426

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