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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 240 - (view) (download)

1 : jhr 137 (* translate.sml
2 :     *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 :     *
6 : jhr 176 * Translate Simple-AST code into the IL representation.
7 : jhr 137 *)
8 :    
9 :     structure Translate : sig
10 :    
11 : jhr 176 val translate : Simple.program -> HighIL.program
12 : jhr 137
13 :     end = struct
14 :    
15 : jhr 176 structure S = Simple
16 : jhr 137 structure VMap = Var.Map
17 : jhr 189 structure VSet = Var.Set
18 : jhr 168 structure IL = HighIL
19 : jhr 137
20 : jhr 197 fun lookup env x = (case VMap.find (env, x)
21 : jhr 176 of SOME x' => x'
22 :     | NONE => raise Fail(concat[
23 : jhr 197 "no binding for ", Var.uniqueNameOf x, " in environment"
24 : jhr 176 ])
25 :     (* end case *))
26 :    
27 : jhr 189 (* create a new instance of a variable *)
28 : jhr 199 fun newVar x = IL.Var.new (Var.nameOf x)
29 : jhr 189
30 : jhr 168 (* expression translation *)
31 : jhr 197 fun cvtExp (env, lhs, exp) = (case exp
32 : jhr 188 of S.E_Var x => [(lhs, IL.VAR(lookup env x))]
33 :     | S.E_Lit lit => [(lhs, IL.LIT lit)]
34 : jhr 176 | S.E_Tuple xs => raise Fail "E_Tuple not implemeted"
35 : jhr 188 | S.E_Apply(f, tyArgs, args, ty) => let
36 :     val args' = List.map (lookup env) args
37 :     in
38 :     TranslateBasis.translate (lhs, f, tyArgs, args')
39 :     end
40 :     | S.E_Cons args => [(lhs, IL.CONS(List.map (lookup env) args))]
41 : jhr 229 | S.E_Input(_, name, NONE) => [(lhs, IL.OP(HighOps.Input name, []))]
42 :     | S.E_Input(_, name, SOME dflt) =>
43 : jhr 226 [(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 : jhr 176 (* end case *))
47 : jhr 168
48 : jhr 192 (* 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 :     * and the set of Simple AST variables that were assigned to in the block.
51 : jhr 189 *)
52 : jhr 192 fun cvtBlock (env, S.Block stms) = let
53 :     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 : jhr 189 val x' = newVar x
57 :     val stms = cvtExp(env, x', e)
58 :     val assigned = VSet.add(assigned, x)
59 :     val env = VMap.insert(env, x, x')
60 :     in
61 : jhr 197 toBlock (env, assigned, rest, stms@assignments)
62 : jhr 189 end
63 : jhr 192 | 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
70 :     and toStmt (env, assigned, []) =
71 :     (IL.mkBLOCK{succ=IL.dummy, body=[]}, env, assigned)
72 : jhr 197 | toStmt (env, assigned, stms as stm::rest) = (case stm
73 :     of S.S_Assign _ => toBlock (env, assigned, stms, [])
74 : jhr 192 | S.S_IfThenElse(x, b1, b2) => let
75 :     val x' = lookup env x
76 : jhr 197 val (s1, env1, assigned1) = cvtBlock(env, b1)
77 :     val (s2, env2, assigned2) = cvtBlock(env, b2)
78 : jhr 192 val assigned = VSet.union(assigned1, assigned2)
79 : jhr 240 (* 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 : jhr 192 val (env, phis) = let
85 : jhr 240 fun mkPhi (x, (env, phis)) = (
86 :     case (VMap.find(env1, x), VMap.find(env2, x))
87 :     of (SOME x1, SOME x2) => let
88 :     val x' = newVar x
89 :     in
90 :     (VMap.insert(env, x, x'), (x', [x1, x2])::phis)
91 :     end
92 :     | _ => (env, phis)
93 :     (* end case *))
94 : jhr 190 in
95 : jhr 192 VSet.foldl mkPhi (env, []) assigned
96 : jhr 190 end
97 : jhr 192 val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
98 : jhr 190 in
99 : jhr 192 case rest
100 :     of [] => (stm, env, assigned)
101 :     | _ => let
102 :     val (join, env, assigned) = toStmt (env, assigned, rest)
103 :     in
104 :     IL.addPred (join, stm);
105 :     IL.setSucc (stm, join);
106 :     (stm, env, assigned)
107 :     end
108 :     (* end case *)
109 : jhr 190 end
110 : jhr 192 | 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 : jhr 194 end
123 : jhr 197 | S.S_Die => (IL.mkDIE(), env, assigned)
124 :     | S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)
125 : jhr 192 (* end case *))
126 :     in
127 :     toStmt (env, VSet.empty, stms)
128 :     end
129 : jhr 168
130 : jhr 240 fun translate (S.Program{globals, globalInit, actors}) = let
131 : jhr 200 val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)
132 :     (* get the SSA names for the globals and a reduced environment *)
133 :     val (env, globs) = let
134 :     val lookup = lookup env
135 :     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 : jhr 176
179 : jhr 137 end

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