Annotation of /branches/charisee/src/compiler/simplify/inliner.sml

Parent Directory | Revision Log

---

Revision 2604 - (view) (download)

1 :	jhr	2356	(* inliner.sml
2 :			*
3 :			* COPYRIGHT (c) 2013 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*
6 :			* This pass eliminates the function definitions by inlining them.
7 :			*)
8 :
9 :			structure Inliner : sig
10 :
11 :			val transform : Simple.program -> Simple.program
12 :
13 :			end = struct
14 :
15 :			structure S = Simple
16 :	jhr	2490	structure V = SimpleVar
17 :	jhr	2356
18 :			(* beta reduce the application "lhs = f(args)" by creating a fresh copy of f's body
19 :			* while mapping the parameters to arguments.
20 :			*)
21 :			fun beta (lhs, S.Func{f, params, body}, args) = let
22 :	jhr	2604	val needsLHSPreDecl = ref false (* set to true if the lhs needs to be declared before the body *)
23 :	jhr	2356	fun rename env x = (case V.Map.find(env, x)
24 :			of SOME x' => x'
25 :	jhr	2490	| NONE => if SimpleVar.isGlobal x
26 :	jhr	2356	then x
27 :			else raise Fail("unknown variable " ^ V.uniqueNameOf x)
28 :			(* end case *))
29 :	jhr	2604	fun doBlock (env, isTop, S.Block stms) = let
30 :	jhr	2356	fun f (stm, (env, stms)) = let
31 :	jhr	2604	val (env, stm) = doStmt (env, isTop, stm)
32 :	jhr	2356	in
33 :			(env, stm::stms)
34 :			end
35 :			val (_, stms) = List.foldl f (env, []) stms
36 :			in
37 :			S.Block(List.rev stms)
38 :			end
39 :	jhr	2604	and doStmt (env, isTop, stm) = (case stm
40 :	jhr	2356	of S.S_Var x => let
41 :			val x' = V.copy x
42 :			in
43 :			(V.Map.insert(env, x, x'), S.S_Var x')
44 :			end
45 :			| S.S_Assign(x, e) => (case V.Map.find(env, x)
46 :			of SOME x' => (env, S.S_Assign(x', doExp env e))
47 :			| NONE => let
48 :			val x' = V.copy x
49 :			in
50 :			(V.Map.insert(env, x, x'), S.S_Assign(x', doExp env e))
51 :			end
52 :			(* end case *))
53 :			| S.S_IfThenElse(x, b1, b2) =>
54 :	jhr	2604	(env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2)))
55 :	jhr	2356	| S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs))
56 :			| S.S_Die => (env, stm)
57 :			| S.S_Stabilize => (env, stm)
58 :	jhr	2604	| S.S_Return x => (
59 :			if not isTop then needsLHSPreDecl := true else ();
60 :			(env, S.S_Assign(lhs, S.E_Var(rename env x))))
61 :	jhr	2356	| S.S_Print xs => (env, S.S_Print(List.map (rename env) xs))
62 :			(* end case *))
63 :			and doExp env exp = (case exp
64 :			of S.E_Var x => S.E_Var(rename env x)
65 :			| S.E_Lit _ => exp
66 :			| S.E_Tuple xs => S.E_Tuple(List.map (rename env) xs)
67 :	jhr	2490	| S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)
68 :			| S.E_Prim(f, tys, xs, ty) =>
69 :			S.E_Prim(f, tys, List.map (rename env) xs, ty)
70 :	jhr	2356	| S.E_Cons xs => S.E_Cons(List.map (rename env) xs)
71 :			| S.E_Slice(x, xs, ty) =>
72 :			S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)
73 :			| S.E_Coerce{srcTy, dstTy, x} =>
74 :			S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}
75 :	jhr	2490	| S.E_Input(_, _, _, NONE) => exp
76 :			| S.E_Input(ty, name, desc, SOME x) =>
77 :			S.E_Input(ty, name, desc, SOME(rename env x))
78 :	jhr	2356	| S.E_LoadImage _ => exp
79 :			(* end case *))
80 :			(* build the initial environment by mapping parameters to arguments *)
81 :			val env = ListPair.foldlEq
82 :			(fn (x, x', env) => V.Map.insert(env, x, x'))
83 :			V.Map.empty (params, args)
84 :	jhr	2604	val blk as S.Block stms = doBlock (env, true, body)
85 :	jhr	2356	in
86 :	jhr	2604	if !needsLHSPreDecl
87 :			then S.Block(S.S_Var lhs :: stms)
88 :			else blk
89 :	jhr	2356	end
90 :
91 :			(* inline expand user-function calls in a block *)
92 :			fun expandBlock funcTbl = let
93 :			val findFunc = V.Tbl.find funcTbl
94 :			fun expandBlk (S.Block stms) =
95 :			S.Block(List.foldr expandStm [] stms)
96 :			and expandStm (stm, stms') = (case stm
97 :	jhr	2490	of S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f
98 :	jhr	2356	of NONE => stm :: stms'
99 :			| SOME func => let
100 :			val S.Block stms = beta(x, func, xs)
101 :			in
102 :			stms @ stms'
103 :			end
104 :			(* end case *))
105 :			| S.S_IfThenElse(x, b1, b2) =>
106 :			S.S_IfThenElse(x, expandBlk b1, expandBlk b2) :: stms'
107 :			| _ => stm :: stms'
108 :			(* end case *))
109 :			in
110 :			expandBlk
111 :			end
112 :
113 :			fun expandFunc funcTbl (S.Func{f, params, body}) = let
114 :			val body' = expandBlock funcTbl body
115 :	jhr	2604	val func' = S.Func{f=f, params=params, body=body'}
116 :	jhr	2356	in
117 :	jhr	2604	V.Tbl.insert funcTbl (f, func')
118 :	jhr	2356	end
119 :
120 :			fun expandStrand funcTbl = let
121 :			val expandBlock = expandBlock funcTbl
122 :			fun expandMeth (S.Method(m, blk)) = S.Method(m, expandBlock blk)
123 :			fun expand (S.Strand{name, params, state, stateInit, methods}) = S.Strand{
124 :			name = name,
125 :			params = params,
126 :			state = state,
127 :			stateInit = expandBlock stateInit,
128 :			methods = List.map expandMeth methods
129 :			}
130 :			in
131 :			expand
132 :			end
133 :
134 :			fun expandInit funcTbl (S.Initially{isArray, rangeInit, iters, create}) = let
135 :			val expandBlock = expandBlock funcTbl
136 :			fun expandCreate (S.C_Create{argInit, name, args}) = S.C_Create{
137 :			argInit = expandBlock argInit,
138 :			name = name, args = args
139 :			}
140 :			in
141 :			S.Initially{
142 :			isArray = isArray,
143 :			rangeInit = expandBlock rangeInit,
144 :			iters = iters,
145 :			create = expandCreate create
146 :			}
147 :			end
148 :
149 :			fun transform (prog as S.Program{funcs=[], ...}) = prog
150 :			| transform (S.Program{globals, globalInit, funcs, strands, init}) = let
151 :			(* a table that maps function names to their definitions *)
152 :			val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")
153 :			(* first we inline expand the function bodies in definition order *)
154 :			val _ = List.app (expandFunc funcTbl) funcs
155 :			val expandBlock = expandBlock funcTbl
156 :			in
157 :			S.Program{
158 :			globals = globals,
159 :			globalInit = expandBlock globalInit,
160 :			funcs = [],
161 :			strands = List.map (expandStrand funcTbl) strands,
162 :			init = expandInit funcTbl init
163 :			}
164 :			end
165 :
166 :			end

---

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