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 240, Fri Aug 6 04:59:16 2010 UTC
# Line 17  Line 17 
17      structure VSet = Var.Set      structure VSet = Var.Set
18      structure IL = HighIL      structure IL = HighIL
19    
20      fun lookup env x = (case VMap.find x      fun lookup env x = (case VMap.find (env, x)
21             of SOME x' => x'             of SOME x' => x'
22              | NONE => raise Fail(concat[              | NONE => raise Fail(concat[
23                    "no binding for ", Var.toString x, " in environment"                    "no binding for ", Var.uniqueNameOf x, " in environment"
24                  ])                  ])
25            (* end case *))            (* end case *))
26    
27    (* create a new instance of a variable *)    (* create a new instance of a variable *)
28      fun newVar x = IL.newVar (Var.nameOf x)      fun newVar x = IL.Var.new (Var.nameOf x)
29    
30    (* expression translation *)    (* expression translation *)
31      fun cvtExpr (env, lhs, exp) = (case exp      fun cvtExp (env, lhs, exp) = (case exp
32             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]             of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
33              | S.E_Lit lit => [(lhs, IL.LIT lit)]              | S.E_Lit lit => [(lhs, IL.LIT lit)]
34              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"              | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
# Line 38  Line 38 
38                    TranslateBasis.translate (lhs, f, tyArgs, args')                    TranslateBasis.translate (lhs, f, tyArgs, args')
39                  end                  end
40              | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]              | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
41                | S.E_Input(_, name, NONE) => [(lhs, IL.OP(HighOps.Input name, []))]
42                | S.E_Input(_, name, SOME dflt) =>
43                    [(lhs, IL.OP(HighOps.InputWithDefault name, [lookup env dflt]))]
44                | S.E_Field fld => [(lhs, IL.OP(HighOps.Field fld, []))]
45                | S.E_LoadImage info => [(lhs, IL.OP(HighOps.LoadImage info, []))]
46            (* end case *))            (* end case *))
47    
48      fun cvtBlock (env, S.Block stms) =    (* convert a Simple AST block to an IL statement.  We return the statement that represents the
49       * block, plus the environment mapping Simple AST variables to their current SSA representations
50    (* 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.  
51     *)     *)
52      and cvtStmt (env, assigned, stm, preStms, k) = (case stm      fun cvtBlock (env, S.Block stms) = let
53             of S.S_Assign(x, e) => let            fun toBlock (env, assigned, [], assignments) =
54                    (IL.mkBLOCK{succ=IL.dummy, body=List.rev assignments}, env, assigned)
55                | toBlock (env, assigned, S.S_Assign(x, e)::rest, assignments) = let
56                  val x' = newVar x                  val x' = newVar x
57                  val stms = cvtExp(env, x', e)                  val stms = cvtExp(env, x', e)
58                  val assigned = VSet.add(assigned, x)                  val assigned = VSet.add(assigned, x)
59                  val env = VMap.insert(env, x, x')                  val env = VMap.insert(env, x, x')
60                  in                  in
61                    k (env, assigned, stm::preStms)                    toBlock (env, assigned, rest, stms@assignments)
62                    end
63                | toBlock (env, assigned, stms, assignments) = let
64                    val (succ, env, assigned) = toStmt (env, assigned, stms)
65                    val blk = IL.mkBLOCK{succ=succ, body=List.rev assignments}
66                    in
67                      IL.addPred (succ, blk);
68                      (blk, env, assigned)
69                  end                  end
70              and toStmt (env, assigned, []) =
71                    (IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)
72                | toStmt (env, assigned, stms as stm::rest) = (case stm
73                     of S.S_Assign _ => toBlock (env, assigned, stms, [])
74              | S.S_IfThenElse(x, b1, b2) => let              | S.S_IfThenElse(x, b1, b2) => let
75                  val x' = lookup env x                  val x' = lookup env x
76                  val (b1, env1, assigned1) = block(env, b1)                        val (s1, env1, assigned1) = cvtBlock(env, b1)
77                  val (b2, env2, assigned2) = block(env, b2)                        val (s2, env2, assigned2) = cvtBlock(env, b2)
78                  val assigned = VSet.union(assigned1, assigned2)                  val assigned = VSet.union(assigned1, assigned2)
79    (* PROBLEM: what about variables that are assigned for the first time in one branch
80     * and not the other?  This situation should only occur for variables who's scope is
81     * the branch of the if.  Short-term solution is to ignore variables that are defined
82     * in only one branch.
83     *)
84                  val (env, phis) = let                  val (env, phis) = let
85                        fun mkPhi (x, (env, phis) = let                              fun mkPhi (x, (env, phis)) = (
86                              val x1 = lookup(env1, x)                                    case (VMap.find(env1, x), VMap.find(env2, x))
87                              val x2 = lookup(env2, x)                                     of (SOME x1, SOME x2) => let
88                              val x' = newVar x                              val x' = newVar x
89                              in                              in
90                                (VMap.insert(env, x, x'), (x', [x1, x2])::phis)                                (VMap.insert(env, x, x'), (x', [x1, x2])::phis)
91                              end                              end
92                                        | _ => (env, phis)
93                                      (* end case *))
94                        in                        in
95                          VSet.foldl mkPhi (env, []) assigned                          VSet.foldl mkPhi (env, []) assigned
96                        end                        end
97                          val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
98                          in
99                            case rest
100                             of [] => (stm, env, assigned)
101                              | _ => let
102                                  val (join, env, assigned) = toStmt (env, assigned, rest)
103                  in                  in
104                                    IL.addPred (join, stm);
105                                    IL.setSucc (stm, join);
106                                    (stm, env, assigned)
107                  end                  end
108              | S.S_New(name, xs) =>                          (* end case *)
109              | S.S_Die =>                        end
110              | S.S_Stabilize =>                    | S.S_New(name, xs) => let
111                          val xs' = List.map (lookup env) xs
112                          in
113                            case rest
114                             of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)
115                              | _ => let
116                                  val (succ, env, assigned) = toStmt (env, assigned, rest)
117                                  val stm = IL.mkNEW{actor=name, args=xs', succ=succ}
118                                  in
119                                    IL.addPred (succ, stm);
120                                    (stm, env, assigned)
121                                  end
122                          end
123                      | S.S_Die => (IL.mkDIE(), env, assigned)
124                      | S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)
125            (* end case *))            (* end case *))
126              in
127                toStmt (env, VSet.empty, stms)
128              end
129    
130      fun newBlock (??, stm) =      fun translate (S.Program{globals, globalInit, actors}) = let
131              val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)
132      and nextStmt (env, assigned, stm, ??) =          (* get the SSA names for the globals and a reduced environment *)
133              val (env, globs) = let
134      and join (env                  val lookup = lookup env
135      fun translate (S.Program{globals, globaInit, actors}) = ??                  fun cvtVar (x, (env, globs)) = let
136                          val x' = lookup x
137                          in
138                            (VMap.insert(env, x, x'), x'::globs)
139                          end
140                    val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
141                    in
142                      (env, List.rev globs)
143                    end
144              fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let
145                    val (env, params) = let
146                          fun cvtParam (x, (env, xs)) = let
147                                val x' = newVar x
148                                in
149                                  (VMap.insert(env, x, x'), x'::xs)
150                                end
151                          val (env, params) = List.foldl cvtParam (env, []) params
152                          in
153                            (env, List.rev params)
154                          end
155                    val (stateInit, env, _) = cvtBlock (env, stateInit)
156                    val state = List.map (lookup env) state
157                    fun cvtMethod (S.Method(name, blk)) = let
158                          val (body, _, _) = cvtBlock (env, blk)
159                          in
160                            IL.Method(name, body)
161                          end
162                    in
163                      IL.Actor{
164                          name = name,
165                          params = params,
166                          state = state,
167                          stateInit = stateInit,
168                          methods = List.map cvtMethod methods
169                        }
170                    end
171              in
172                IL.Program{
173                    globals = globs,
174                    globalInit = globalInit,
175                    actors = List.map cvtActor actors
176                  }
177              end
178    
179    end    end

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

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