Diff of /trunk/src/compiler/IL/translate-fn.sml

Parent Directory | Revision Log | Patch

	revision 360, Wed Sep 29 02:59:34 2010 UTC	revision 361, Wed Sep 29 14:17:34 2010 UTC
#	Line 13	Line 13
13	structure SrcIL : SSA	structure SrcIL : SSA
14	structure DstIL : SSA	structure DstIL : SSA
15
16	type env = DstIL.var SrcIL.Var.Tbl.hash_table	type var_env = DstIL.var SrcIL.Var.Tbl.hash_table
17
18	val rename : (env * SrcIL.var) -> DstIL.var	val rename : (var_env * SrcIL.var) -> DstIL.var
19	val expand : (env * SrcIL.assign) -> DstIL.assign list	val expand : (var_env * SrcIL.assign) -> DstIL.assign list
20
21	end	end
22
23	functor Translate (Params : TRANSLATE_PARAMS) : sig	functor TranslateFn (Params : TRANSLATE_PARAMS) : sig
24
25	structure SrcIL : SSA	structure SrcIL : SSA
26	structure DstIL : SSA	structure DstIL : SSA
27
28	val translate : env * SrcIL.stmt -> DstIL.stmt	type var_env = DstIL.var SrcIL.Var.Tbl.hash_table
29
30		val translate : var_env * SrcIL.stmt -> DstIL.stmt
31
32	end = struct	end = struct
33
34	structure SrcIL : SSA = Params.SrcIL	structure SrcIL : SSA = Params.SrcIL
35	structure SrcNd = SrcIL.Node	structure SrcNd = SrcIL.Node
36	structure DstIL : SSA = Params.DstIL	structure DstIL : SSA = Params.DstIL
37		structure DstNd = DstIL.Node
38		structure DstStm = DstIL.Stmt
39
40		type var_env = Params.var_env
41
42	datatype env = E of {	datatype env = E of {
43	ndMap : DstIL.node Stamp.Tbl.hash_table,	ndMap : DstIL.node Stamp.Tbl.hash_table,
44	vMap : Params.env	vMap : var_env
45	}	}
46
47	fun rename (E{vMap, ...}, x) = Params.rename(vMap, x)	fun rename (E{vMap, ...}) x = Params.rename(vMap, x)
48
49	fun expand (E{vMap, ...}) (assign, assigns') =	fun expand (E{vMap, ...}) (assign, assigns') =
50	Params.expand (vMap, assign) @ assigns'	Params.expand (vMap, assign) @ assigns'
51
52		fun insertNd (E{ndMap, ...}, id, nd) = Stamp.Tbl.insert ndMap (id, nd)
53
54		fun renameNd (E{ndMap, ...}) (nd as SrcIL.ND{id, ...}) = (
55		case Stamp.Tbl.find ndMap id
56		of SOME nd' => nd'
57		| NONE => raise Fail("unable to find " ^ SrcNd.toString nd)
58		(* end case *))
59
60	(* the first pass creates the nodes of the DstIL CFG and defines	(* the first pass creates the nodes of the DstIL CFG and defines
61	* the environment that maps from SrcIL nodes and variables to	* the environment that maps from SrcIL nodes and variables to
62	* DstIL nodes and variables.	* DstIL nodes and variables.
#	Line 54	Line 68
68	| SrcIL.ENTRY _ => DstNd.mkENTRY()	| SrcIL.ENTRY _ => DstNd.mkENTRY()
69	| SrcIL.JOIN{phis, ...} => let	| SrcIL.JOIN{phis, ...} => let
70	fun cvtPhi (x, xs) =	fun cvtPhi (x, xs) =
71	(rename(env, x), List.map (fn x => rename(env, x)) xs)	(rename env x, List.map (rename env) xs)
72	in	in
73	DstNd.mkJOIN(List.map cvtPhi phis)	DstNd.mkJOIN(List.map cvtPhi (!phis))
74	end	end
75	| SrcIL.COND{cond, trueBranch, falseBranch, ...} => DstNd.mkCOND{	| SrcIL.COND{cond, ...} => DstNd.mkCOND{
76	cond = rename(env, cond),	cond = rename env cond,
77	trueBranch = DstNd.dummy,	trueBranch = DstNd.dummy,
78	trueBranch = DstNd.dummy	falseBranch = DstNd.dummy
79	}	}
80	| SrcIL.BLOCK{body, ...} => let	| SrcIL.BLOCK{body, ...} => let
81	val body' = List.foldr (expand env) [] (!body)	val body' = List.foldr (expand env) [] (!body)
#	Line 70	Line 84
84	end	end
85	| SrcIL.NEW{actor, args, ...} => DstNd.mkNEW{	| SrcIL.NEW{actor, args, ...} => DstNd.mkNEW{
86	actor = actor,	actor = actor,
87	args = List.map (fn x => rename(env, x)) args	args = List.map (rename env) args
88	}	}
89	| SrcIL.DIE _ => DstNd.mkDIE()	| SrcIL.DIE _ => DstNd.mkDIE()
90	| SrcIL.STABILIZE _ => DstNd.mkSTABILIZE()	| SrcIL.STABILIZE _ => DstNd.mkSTABILIZE()
#	Line 83	Line 97
97	SrcIL.applyToNodes trans stm	SrcIL.applyToNodes trans stm
98	end	end
99
100	fun translate (env, stm) = (case kind	(* the second pass copys the statement tree and sets the CFG edges; it
101	of SrcIL.S_SIMPLE(SrcIL.ND{kind, ...}) => (case kind	* returns the new statement tree.
102	of NULL =>	*)
103	| ENTRY{succ} =>	fun translateStmts (env, stm) = let
104	| JOIN{preds, phis, succ} =>	val renameNd = renameNd env
105	| COND{pred, cond, trueBranch, falseBranch} =>	fun trans (SrcIL.STM{kind, next, ...}) = let
106	raise Fail "impossible"	fun new kind' = DstStm.new(kind', Option.map trans next)
107	| BLOCK{pred, body, succ} =>	in
108	| NEW{pred, actor, args, succ} =>	case kind
109	| DIE{pred, ...} =>	of SrcIL.S_SIMPLE nd => new (DstIL.S_SIMPLE(renameNd nd))
110	| STABILIZE{pred} =>	| SrcIL.S_IF{cond, thenBranch, elseBranch} => new (DstIL.S_IF{
111	| EXIT{pred} =>	cond = renameNd cond,
112	(* end case *))	thenBranch = trans thenBranch,
113	| SrcIL.S_IF{cond, thenBranch, elseBranch} =>	elseBranch = trans elseBranch
114	| SrcIL.S_LOOP{hdr, cond, body} =>	})
115	(* end case *))	| SrcIL.S_LOOP{hdr, cond, body} => new (DstIL.S_LOOP{
116		hdr = trans hdr,
117		cond = renameNd cond,
118		body = trans body
119		})
120		(* end case *)
121		end
122		in
123		trans stm
124		end
125
126	and translateOpt (env, NONE) = NONE	fun translate (vMap, stm) = let
127	| translateOpt (env, SOME stm) = translate (env, stm)	val env = E{
128		ndMap = Stamp.Tbl.mkTable (256, raise Fail "ndMap"),
129		vMap = vMap
130		}
131		val _ = translateNodes (env, stm)
132		in
133		translateStmts (env, stm)
134		end
135
136	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.360   changed lines   Added in v.361

---

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