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

SCM Repository

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

Diff of /branches/lamont_dev/src/compiler/translate/translate.sml

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

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

Legend:
Removed from v.192  
changed lines
  Added in v.511

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