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 255, Sun Aug 8 14:55:53 2010 UTC revision 256, Mon Aug 9 17:28:57 2010 UTC
# Line 49  Line 49 
49     * 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
50     * 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.
51     *)     *)
52      fun cvtBlock (env, S.Block stms) = let      fun cvtBlock (env, S.Block stms, optExit) = let
53            fun toBlock (env, assigned, [], assignments) =            fun toBlock (env, assigned, [], assignments) = let
54                  (IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)                  val stm = IL.Stmt.mkBLOCK(List.rev assignments, optExit)
55                    in
56                      (stm, IL.Stmt.tail stm, env, assigned)
57                    end
58              | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let              | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
59                  val x' = newVar x                  val x' = newVar x
60                  val stms = cvtExp(env, x', e)                  val stms = cvtExp(env, x', e)
# Line 61  Line 64 
64                    toBlock (env, assigned, rest, stms@assignments)                    toBlock (env, assigned, rest, stms@assignments)
65                  end                  end
66              | toBlock (env, assigned, stms, assignments) = let              | toBlock (env, assigned, stms, assignments) = let
67                  val (succ, env, assigned) = toStmt (env, assigned, stms)                  val (next, last, env, assigned) = toStmt (env, assigned, stms)
68                  val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}                  val blk = IL.Stmt.mkBLOCK(List.rev assignments, SOME next)
69                    in
70                      IL.Node.addEdge (IL.Stmt.tail blk, IL.Stmt.entry next);
71                      (blk, last, env, assigned)
72                    end
73              and toStmt (env, assigned, []) = let
74                  (* this case only occurs for the empty else arm of an if-then-else statement *)
75                    val stm = IL.Stmt.mkBLOCK([], optExit)
76                  in                  in
77                    IL.addPred (succ, blk);                    (stm, IL.Stmt.tail stm, env, assigned)
                   (blk, env, assigned)  
78                  end                  end
           and toStmt (env, assigned, []) =  
                 (IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)  
79              | toStmt (env, assigned, stms as stm::rest) = (case stm              | toStmt (env, assigned, stms as stm::rest) = (case stm
80                   of S.S_Assign _ => toBlock (env, assigned, stms, [])                   of S.S_Assign _ => toBlock (env, assigned, stms, [])
81                    | S.S_IfThenElse(x, b1, b2) => let                    | S.S_IfThenElse(x, b1, b2) => let
82                        val x' = lookup env x                        val x' = lookup env x
83                        val (s1, env1, assigned1) = cvtBlock(env, b1)                        val (s1, last1, env1, assigned1) = cvtBlock(env, b1, NONE)
84                        val (s2, env2, assigned2) = cvtBlock(env, b2)                        val (s2, last2, env2, assigned2) = cvtBlock(env, b2, NONE)
85                        val assigned = VSet.union(assigned1, assigned2)                        val assigned = VSet.union(assigned1, assigned2)
86  (* PROBLEM: what about variables that are assigned for the first time in one branch  (* PROBLEM: what about variables that are assigned for the first time in one branch
87   * and not the other?  This situation should only occur for variables who's scope is   * and not the other?  This situation should only occur for variables who's scope is
# Line 94  Line 101 
101                              in                              in
102                                VSet.foldl mkPhi (env, []) assigned                                VSet.foldl mkPhi (env, []) assigned
103                              end                              end
                       val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}  
104                        in                        in
105                          case rest                          case rest
106                           of [] => (stm, env, assigned)                           of [] => let
107                                  val join = IL.Stmt.mkJOIN (phis, optExit)
108                                  val joinNd = IL.Stmt.entry join
109                                  val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
110                                  in
111                                    IL.Node.addEdge (last2, joinNd);
112                                    IL.Node.addEdge (last1, joinNd);
113                                    (stm, joinNd, env, assigned)
114                                  end
115                            | _ => let                            | _ => let
116                                val (join, env, assigned) = toStmt (env, assigned, rest)                                val (next, last, env, assigned) = toStmt (env, assigned, rest)
117                                in                                val join = IL.Stmt.mkJOIN (phis, SOME next)
118                                  IL.addPred (join, stm);                                val joinNd = IL.Stmt.entry join
119                                  IL.setSucc (stm, join);                                val stm = IL.Stmt.mkIF(x', s1, s2, SOME join)
120                                  (stm, env, assigned)                                in
121                                    IL.Node.addEdge (last2, joinNd);
122                                    IL.Node.addEdge (last1, joinNd);
123                                    IL.Node.addEdge (joinNd, IL.Stmt.entry next);
124                                    (stm, last, env, assigned)
125                                end                                end
126                          (* end case *)                          (* end case *)
127                        end                        end
# Line 111  Line 129 
129                        val xs' = List.map (lookup env) xs                        val xs' = List.map (lookup env) xs
130                        in                        in
131                          case rest                          case rest
132                           of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)                           of [] => let
133                                  val stm = IL.Stmt.mkNEW(name, xs', optExit)
134                                  in
135                                    (stm, IL.Stmt.tail stm, env, assigned)
136                                  end
137                            | _ => let                            | _ => let
138                                val (succ, env, assigned) = toStmt (env, assigned, rest)                                val (next, last, env, assigned) = toStmt (env, assigned, rest)
139                                val stm = IL.mkNEW{actor=name, args=xs', succ=succ}                                val stm = IL.Stmt.mkNEW(name, xs', SOME next)
140                                  in
141                                    IL.Node.addEdge (IL.Stmt.tail stm, IL.Stmt.entry next);
142                                    (stm, last, env, assigned)
143                                  end
144                          end
145                      | S.S_Die => let
146                          val stm = IL.Stmt.mkDIE()
147                                in                                in
148                                  IL.addPred (succ, stm);                          (stm, IL.Stmt.tail stm, env, assigned)
                                 (stm, env, assigned)  
149                                end                                end
150                      | S.S_Stabilize => let
151                          val stm = IL.Stmt.mkSTABILIZE()
152                          in
153                            (stm, IL.Stmt.tail stm, env, assigned)
154                        end                        end
                   | S.S_Die => (IL.mkDIE(), env, assigned)  
                   | S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)  
155                  (* end case *))                  (* end case *))
156            in            in
157              toStmt (env, VSet.empty, stms)              toStmt (env, VSet.empty, stms)
158            end            end
159    
160        fun cvtTopLevelBlock (env, blk) = let
161              val exit = IL.Stmt.mkEXIT ()
162              val (stm, last, env, assigned) = cvtBlock (env, blk, SOME exit)
163              val entry = IL.Stmt.mkENTRY (SOME stm)
164              in
165                IL.Node.addEdge (IL.Stmt.tail entry, IL.Stmt.entry stm);
166              (* NOTE: this could fail if all control paths end in DIE or STABILIZE, so we
167               * wrap it in a handler
168               *)
169                IL.Node.addEdge (last, IL.Stmt.entry exit) handle _ => ();
170                (entry, env)
171              end
172    
173      (* generate fresh SSA variables and add them to the environment *)
174        fun freshVars (env, xs) = let
175              fun cvtVar (x, (env, xs)) = let
176                    val x' = newVar x
177                    in
178                      (VMap.insert(env, x, x'), x'::xs)
179                    end
180              val (env, xs) = List.foldl cvtVar (env, []) xs
181              in
182                (env, List.rev xs)
183              end
184    
185      fun translate (S.Program{globals, globalInit, actors}) = let      fun translate (S.Program{globals, globalInit, actors}) = let
186            val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)            val (globalInit, env) = cvtTopLevelBlock (VMap.empty, globalInit)
187          (* get the SSA names for the globals and a reduced environment *)          (* get the SSA names for the globals and a reduced environment that just defines
188             * the globals.
189             *)
190            val (env, globs) = let            val (env, globs) = let
191                  val lookup = lookup env                  val lookup = lookup env
192                  fun cvtVar (x, (env, globs)) = let                  fun cvtVar (x, (env, globs)) = let
# Line 152  Line 209 
209                        in                        in
210                          (env, List.rev params)                          (env, List.rev params)
211                        end                        end
212                  val (stateInit, env, _) = cvtBlock (env, stateInit)                  val (stateInit, env) = cvtTopLevelBlock (env, stateInit)
213                  val state = List.map (lookup env) state                  val state' = List.map (lookup env) state
214                  fun cvtMethod (S.Method(name, blk)) = let                  fun cvtMethod (S.Method(name, blk)) = let
215                        val (body, _, _) = cvtBlock (env, blk)                      (* allocate fresh variables for the state variables *)
216                          val (env, stateIn) = freshVars (env, state)
217                          val (body, env) = cvtTopLevelBlock (env, blk)
218                          val stateOut = List.map (lookup env) state
219                        in                        in
220                          IL.Method(name, body)                          IL.Method{name=name, stateIn=stateIn, stateOut=stateOut, body=body}
221                        end                        end
222                  in                  in
223                    IL.Actor{                    IL.Actor{
224                        name = name,                        name = name,
225                        params = params,                        params = params,
226                        state = state,                        state = state',
227                        stateInit = stateInit,                        stateInit = stateInit,
228                        methods = List.map cvtMethod methods                        methods = List.map cvtMethod methods
229                      }                      }

Legend:
Removed from v.255  
changed lines
  Added in v.256

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