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

Parent Directory | Revision Log

---

Revision 2490 - (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 :			fun rename env x = (case V.Map.find(env, x)
23 :			of SOME x' => x'
24 :	jhr	2490	| NONE => if SimpleVar.isGlobal x
25 :	jhr	2356	then x
26 :			else raise Fail("unknown variable " ^ V.uniqueNameOf x)
27 :			(* end case *))
28 :			fun doBlock (env, S.Block stms) = let
29 :			fun f (stm, (env, stms)) = let
30 :			val (env, stm) = doStmt (env, stm)
31 :			in
32 :			(env, stm::stms)
33 :			end
34 :			val (_, stms) = List.foldl f (env, []) stms
35 :			in
36 :			S.Block(List.rev stms)
37 :			end
38 :			and doStmt (env, stm) = (case stm
39 :			of S.S_Var x => let
40 :			val x' = V.copy x
41 :			in
42 :			(V.Map.insert(env, x, x'), S.S_Var x')
43 :			end
44 :			| S.S_Assign(x, e) => (case V.Map.find(env, x)
45 :			of SOME x' => (env, S.S_Assign(x', doExp env e))
46 :			| NONE => let
47 :			val x' = V.copy x
48 :			in
49 :			(V.Map.insert(env, x, x'), S.S_Assign(x', doExp env e))
50 :			end
51 :			(* end case *))
52 :			| S.S_IfThenElse(x, b1, b2) =>
53 :			(env, S.S_IfThenElse(rename env x, doBlock(env, b1), doBlock(env, b2)))
54 :			| S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs))
55 :			| S.S_Die => (env, stm)
56 :			| S.S_Stabilize => (env, stm)
57 :			| S.S_Return x => (env, S.S_Assign(lhs, S.E_Var(rename env x)))
58 :			| S.S_Print xs => (env, S.S_Print(List.map (rename env) xs))
59 :			(* end case *))
60 :			and doExp env exp = (case exp
61 :			of S.E_Var x => S.E_Var(rename env x)
62 :			| S.E_Lit _ => exp
63 :			| S.E_Tuple xs => S.E_Tuple(List.map (rename env) xs)
64 :	jhr	2490	| S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)
65 :			| S.E_Prim(f, tys, xs, ty) =>
66 :			S.E_Prim(f, tys, List.map (rename env) xs, ty)
67 :	jhr	2356	| S.E_Cons xs => S.E_Cons(List.map (rename env) xs)
68 :			| S.E_Slice(x, xs, ty) =>
69 :			S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)
70 :			| S.E_Coerce{srcTy, dstTy, x} =>
71 :			S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}
72 :	jhr	2490	| S.E_Input(_, _, _, NONE) => exp
73 :			| S.E_Input(ty, name, desc, SOME x) =>
74 :			S.E_Input(ty, name, desc, SOME(rename env x))
75 :	jhr	2356	| S.E_LoadImage _ => exp
76 :			(* end case *))
77 :			(* build the initial environment by mapping parameters to arguments *)
78 :			val env = ListPair.foldlEq
79 :			(fn (x, x', env) => V.Map.insert(env, x, x'))
80 :			V.Map.empty (params, args)
81 :			in
82 :			doBlock (env, body)
83 :			end
84 :
85 :			(* inline expand user-function calls in a block *)
86 :			fun expandBlock funcTbl = let
87 :			val findFunc = V.Tbl.find funcTbl
88 :			fun expandBlk (S.Block stms) =
89 :			S.Block(List.foldr expandStm [] stms)
90 :			and expandStm (stm, stms') = (case stm
91 :	jhr	2490	of S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f
92 :	jhr	2356	of NONE => stm :: stms'
93 :			| SOME func => let
94 :			val S.Block stms = beta(x, func, xs)
95 :			in
96 :			stms @ stms'
97 :			end
98 :			(* end case *))
99 :			| S.S_IfThenElse(x, b1, b2) =>
100 :			S.S_IfThenElse(x, expandBlk b1, expandBlk b2) :: stms'
101 :			| _ => stm :: stms'
102 :			(* end case *))
103 :			in
104 :			expandBlk
105 :			end
106 :
107 :			fun expandFunc funcTbl (S.Func{f, params, body}) = let
108 :			val body' = expandBlock funcTbl body
109 :			in
110 :			V.Tbl.insert funcTbl (f, S.Func{f=f, params=params, body=body'})
111 :			end
112 :
113 :			fun expandStrand funcTbl = let
114 :			val expandBlock = expandBlock funcTbl
115 :			fun expandMeth (S.Method(m, blk)) = S.Method(m, expandBlock blk)
116 :			fun expand (S.Strand{name, params, state, stateInit, methods}) = S.Strand{
117 :			name = name,
118 :			params = params,
119 :			state = state,
120 :			stateInit = expandBlock stateInit,
121 :			methods = List.map expandMeth methods
122 :			}
123 :			in
124 :			expand
125 :			end
126 :
127 :			fun expandInit funcTbl (S.Initially{isArray, rangeInit, iters, create}) = let
128 :			val expandBlock = expandBlock funcTbl
129 :			fun expandCreate (S.C_Create{argInit, name, args}) = S.C_Create{
130 :			argInit = expandBlock argInit,
131 :			name = name, args = args
132 :			}
133 :			in
134 :			S.Initially{
135 :			isArray = isArray,
136 :			rangeInit = expandBlock rangeInit,
137 :			iters = iters,
138 :			create = expandCreate create
139 :			}
140 :			end
141 :
142 :			fun transform (prog as S.Program{funcs=[], ...}) = prog
143 :			| transform (S.Program{globals, globalInit, funcs, strands, init}) = let
144 :			(* a table that maps function names to their definitions *)
145 :			val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")
146 :			(* first we inline expand the function bodies in definition order *)
147 :			val _ = List.app (expandFunc funcTbl) funcs
148 :			val expandBlock = expandBlock funcTbl
149 :			in
150 :			S.Program{
151 :			globals = globals,
152 :			globalInit = expandBlock globalInit,
153 :			funcs = [],
154 :			strands = List.map (expandStrand funcTbl) strands,
155 :			init = expandInit funcTbl init
156 :			}
157 :			end
158 :
159 :			end

---

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