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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3451 - (view) (download)

1 : jhr 3437 (* inliner.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2015 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * This pass eliminates the function definitions by inlining them.
9 :     *)
10 :    
11 :     structure Inliner : sig
12 :    
13 :     val transform : Simple.program -> Simple.program
14 :    
15 :     end = struct
16 :    
17 :     structure S = Simple
18 :     structure V = SimpleVar
19 :    
20 :     (* beta reduce the application "lhs = f(args)" by creating a fresh copy of f's body
21 :     * while mapping the parameters to arguments.
22 :     *)
23 :     fun beta (lhs, S.Func{f, params, body}, args) = let
24 :     val needsLHSPreDecl = ref false (* set to true if the lhs needs to be declared before the body *)
25 :     fun rename env x = (case V.Map.find(env, x)
26 :     of SOME x' => x'
27 :     | NONE => if SimpleVar.hasGlobalScope x
28 :     then x
29 :     else raise Fail("unknown variable " ^ V.uniqueNameOf x)
30 :     (* end case *))
31 :     fun doBlock (env, isTop, S.Block stms) = let
32 :     fun f (stm, (env, stms)) = let
33 :     val (env, stm) = doStmt (env, isTop, stm)
34 :     in
35 :     (env, stm::stms)
36 :     end
37 :     val (_, stms) = List.foldl f (env, []) stms
38 :     in
39 :     S.Block(List.rev stms)
40 :     end
41 :     and doStmt (env, isTop, stm) = (case stm
42 :     of S.S_Var x => let
43 :     val x' = V.copy x
44 :     in
45 :     (V.Map.insert(env, x, x'), S.S_Var x')
46 :     end
47 :     | S.S_Assign(x, e) => (case V.Map.find(env, x)
48 :     of SOME x' => (env, S.S_Assign(x', doExp env e))
49 :     | NONE => let
50 :     val x' = V.copy x
51 :     in
52 :     (V.Map.insert(env, x, x'), S.S_Assign(x', doExp env e))
53 :     end
54 :     (* end case *))
55 :     | S.S_IfThenElse(x, b1, b2) =>
56 :     (env, S.S_IfThenElse(rename env x, doBlock(env, false, b1), doBlock(env, false, b2)))
57 :     | S.S_New(strnd, xs) => (env, S.S_New(strnd, List.map (rename env) xs))
58 :     | S.S_Die => (env, stm)
59 :     | S.S_Stabilize => (env, stm)
60 :     | S.S_Return x => (
61 :     if not isTop then needsLHSPreDecl := true else ();
62 :     (env, S.S_Assign(lhs, S.E_Var(rename env x))))
63 :     | S.S_Print xs => (env, S.S_Print(List.map (rename env) xs))
64 :     (* end case *))
65 :     and doExp env exp = (case exp
66 :     of S.E_Var x => S.E_Var(rename env x)
67 :     | S.E_Lit _ => exp
68 :     | S.E_Apply(f, xs, ty) => S.E_Apply(f, List.map (rename env) xs, ty)
69 :     | S.E_Prim(f, tys, xs, ty) =>
70 :     S.E_Prim(f, tys, List.map (rename env) xs, ty)
71 : jhr 3451 | S.E_Cons(xs, ty) => S.E_Cons(List.map (rename env) xs, ty)
72 : jhr 3437 | S.E_Seq(xs, ty) => S.E_Seq(List.map (rename env) xs, ty)
73 :     | S.E_Slice(x, xs, ty) =>
74 :     S.E_Slice(rename env x, List.map (Option.map (rename env)) xs, ty)
75 :     | S.E_Coerce{srcTy, dstTy, x} =>
76 :     S.E_Coerce{srcTy=srcTy, dstTy=dstTy, x=rename env x}
77 :     | S.E_LoadSeq _ => exp
78 :     | 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 :     val blk as S.Block stms = doBlock (env, true, body)
85 :     in
86 :     if !needsLHSPreDecl
87 :     then S.Block(S.S_Var lhs :: stms)
88 :     else blk
89 :     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 :     of S.S_Assign(x, S.E_Apply(f, xs, _)) => (case findFunc f
98 :     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 :     val func' = S.Func{f=f, params=params, body=body'}
116 :     in
117 :     V.Tbl.insert funcTbl (f, func')
118 :     end
119 :    
120 :     fun expandStrand funcTbl = let
121 :     val expandBlock = expandBlock funcTbl
122 : jhr 3451 fun expand (S.Strand{name, params, state, stateInit, initM, updateM, stabilizeM}) =
123 :     S.Strand{
124 :     name = name,
125 :     params = params,
126 :     state = state,
127 :     stateInit = expandBlock stateInit,
128 :     initM = Option.map expandBlock initM,
129 :     updateM = expandBlock updateM,
130 :     stabilizeM = Option.map expandBlock stabilizeM
131 :     }
132 : jhr 3437 in
133 :     expand
134 :     end
135 :    
136 :     fun transform (prog as S.Program{funcs=[], ...}) = prog
137 : jhr 3451 | transform prog = let
138 :     val S.Program{props, inputs, globals, funcs, init, strand, create, update} = prog
139 : jhr 3437 (* a table that maps function names to their definitions *)
140 :     val funcTbl = V.Tbl.mkTable (List.length funcs, Fail "funcTbl")
141 :     (* first we inline expand the function bodies in definition order *)
142 :     val _ = List.app (expandFunc funcTbl) funcs
143 :     val expandBlock = expandBlock funcTbl
144 :     in
145 :     S.Program{
146 :     props = props,
147 :     inputs = inputs,
148 :     globals = globals,
149 : jhr 3451 init = expandBlock init,
150 : jhr 3437 funcs = [],
151 : jhr 3451 strand = expandStrand funcTbl strand,
152 :     create = expandBlock create,
153 :     update = Option.map expandBlock update
154 : jhr 3437 }
155 :     end
156 :    
157 :     end

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