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

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/simplify/inliner.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2356 - (view) (download)
Original Path: trunk/src/compiler/simplify/inliner.sml

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 :     structure V = Var
17 :    
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 :     | NONE => if Var.isGlobal x
25 :     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 :     | S.E_Apply(f, tys, xs, ty) =>
65 :     S.E_Apply(f, tys, List.map (rename env) xs, ty)
66 :     | S.E_Cons xs => S.E_Cons(List.map (rename env) xs)
67 :     | S.E_Slice(x, xs, ty) =>
68 :     S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)
69 :     | S.E_Coerce{srcTy, dstTy, x} =>
70 :     S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}
71 :     | S.E_LoadImage _ => exp
72 :     (* end case *))
73 :     (* build the initial environment by mapping parameters to arguments *)
74 :     val env = ListPair.foldlEq
75 :     (fn (x, x', env) => V.Map.insert(env, x, x'))
76 :     V.Map.empty (params, args)
77 :     in
78 :     doBlock (env, body)
79 :     end
80 :    
81 :     (* inline expand user-function calls in a block *)
82 :     fun expandBlock funcTbl = let
83 :     val findFunc = V.Tbl.find funcTbl
84 :     fun expandBlk (S.Block stms) =
85 :     S.Block(List.foldr expandStm [] stms)
86 :     and expandStm (stm, stms') = (case stm
87 :     of S.S_Assign(x, S.E_Apply(f, [], xs, _)) => (case findFunc f
88 :     of NONE => stm :: stms'
89 :     | SOME func => let
90 :     val S.Block stms = beta(x, func, xs)
91 :     in
92 :     stms @ stms'
93 :     end
94 :     (* end case *))
95 :     | S.S_IfThenElse(x, b1, b2) =>
96 :     S.S_IfThenElse(x, expandBlk b1, expandBlk b2) :: stms'
97 :     | _ => stm :: stms'
98 :     (* end case *))
99 :     in
100 :     expandBlk
101 :     end
102 :    
103 :     fun expandFunc funcTbl (S.Func{f, params, body}) = let
104 :     val body' = expandBlock funcTbl body
105 :     in
106 :     V.Tbl.insert funcTbl (f, S.Func{f=f, params=params, body=body'})
107 :     end
108 :    
109 :     fun expandStrand funcTbl = let
110 :     val expandBlock = expandBlock funcTbl
111 :     fun expandMeth (S.Method(m, blk)) = S.Method(m, expandBlock blk)
112 :     fun expand (S.Strand{name, params, state, stateInit, methods}) = S.Strand{
113 :     name = name,
114 :     params = params,
115 :     state = state,
116 :     stateInit = expandBlock stateInit,
117 :     methods = List.map expandMeth methods
118 :     }
119 :     in
120 :     expand
121 :     end
122 :    
123 :     fun expandInit funcTbl (S.Initially{isArray, rangeInit, iters, create}) = let
124 :     val expandBlock = expandBlock funcTbl
125 :     fun expandCreate (S.C_Create{argInit, name, args}) = S.C_Create{
126 :     argInit = expandBlock argInit,
127 :     name = name, args = args
128 :     }
129 :     in
130 :     S.Initially{
131 :     isArray = isArray,
132 :     rangeInit = expandBlock rangeInit,
133 :     iters = iters,
134 :     create = expandCreate create
135 :     }
136 :     end
137 :    
138 :     fun transform (prog as S.Program{funcs=[], ...}) = prog
139 :     | transform (S.Program{globals, globalInit, funcs, strands, init}) = let
140 :     (* a table that maps function names to their definitions *)
141 :     val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")
142 :     (* first we inline expand the function bodies in definition order *)
143 :     val _ = List.app (expandFunc funcTbl) funcs
144 :     val expandBlock = expandBlock funcTbl
145 :     in
146 :     S.Program{
147 :     globals = globals,
148 :     globalInit = expandBlock globalInit,
149 :     funcs = [],
150 :     strands = List.map (expandStrand funcTbl) strands,
151 :     init = expandInit funcTbl init
152 :     }
153 :     end
154 :    
155 :     end

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