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

Parent Directory | Revision Log

---

Revision 227 - (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	226	| 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 :	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 :			val (env, phis) = let
80 :	jhr	194	fun mkPhi (x, (env, phis)) = let
81 :	jhr	197	val x1 = lookup env1 x
82 :			val x2 = lookup env2 x
83 :	jhr	192	val x' = newVar x
84 :			in
85 :			(VMap.insert(env, x, x'), (x', [x1, x2])::phis)
86 :			end
87 :	jhr	190	in
88 :	jhr	192	VSet.foldl mkPhi (env, []) assigned
89 :	jhr	190	end
90 :	jhr	192	val stm = IL.mkIF{cond=x', thenBranch=s1, elseBranch=s2}
91 :	jhr	190	in
92 :	jhr	192	case rest
93 :			of [] => (stm, env, assigned)
94 :			| _ => let
95 :			val (join, env, assigned) = toStmt (env, assigned, rest)
96 :			in
97 :			IL.addPred (join, stm);
98 :			IL.setSucc (stm, join);
99 :			(stm, env, assigned)
100 :			end
101 :			(* end case *)
102 :	jhr	190	end
103 :	jhr	192	| S.S_New(name, xs) => let
104 :			val xs' = List.map (lookup env) xs
105 :			in
106 :			case rest
107 :			of [] => (IL.mkNEW{actor=name, args=xs', succ=IL.dummy}, env, assigned)
108 :			| _ => let
109 :			val (succ, env, assigned) = toStmt (env, assigned, rest)
110 :			val stm = IL.mkNEW{actor=name, args=xs', succ=succ}
111 :			in
112 :			IL.addPred (succ, stm);
113 :			(stm, env, assigned)
114 :			end
115 :	jhr	194	end
116 :	jhr	197	| S.S_Die => (IL.mkDIE(), env, assigned)
117 :			| S.S_Stabilize => (IL.mkSTABILIZE(), env, assigned)
118 :	jhr	192	(* end case *))
119 :			in
120 :			toStmt (env, VSet.empty, stms)
121 :			end
122 :	jhr	168
123 :	jhr	227	fun translate (S.Program{globals, staticInit, globalInit, actors}) = let
124 :	jhr	200	val (globalInit, env, _) = cvtBlock (VMap.empty, globalInit)
125 :			(* get the SSA names for the globals and a reduced environment *)
126 :			val (env, globs) = let
127 :			val lookup = lookup env
128 :			fun cvtVar (x, (env, globs)) = let
129 :			val x' = lookup x
130 :			in
131 :			(VMap.insert(env, x, x'), x'::globs)
132 :			end
133 :			val (env, globs) = List.foldl cvtVar (VMap.empty, []) globals
134 :			in
135 :			(env, List.rev globs)
136 :			end
137 :			fun cvtActor (S.Actor{name, params, state, stateInit, methods}) = let
138 :			val (env, params) = let
139 :			fun cvtParam (x, (env, xs)) = let
140 :			val x' = newVar x
141 :			in
142 :			(VMap.insert(env, x, x'), x'::xs)
143 :			end
144 :			val (env, params) = List.foldl cvtParam (env, []) params
145 :			in
146 :			(env, List.rev params)
147 :			end
148 :			val (stateInit, env, _) = cvtBlock (env, stateInit)
149 :			val state = List.map (lookup env) state
150 :			fun cvtMethod (S.Method(name, blk)) = let
151 :			val (body, _, _) = cvtBlock (env, blk)
152 :			in
153 :			IL.Method(name, body)
154 :			end
155 :			in
156 :			IL.Actor{
157 :			name = name,
158 :			params = params,
159 :			state = state,
160 :			stateInit = stateInit,
161 :			methods = List.map cvtMethod methods
162 :			}
163 :			end
164 :			in
165 :			IL.Program{
166 :			globals = globs,
167 :			globalInit = globalInit,
168 :			actors = List.map cvtActor actors
169 :			}
170 :			end
171 :	jhr	176
172 :	jhr	137	end

---

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