Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/FLINT/opt/collect.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/FLINT/opt/collect.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 202 - (view) (download)

1 : monnier 121 (* copyright 1998 YALE FLINT PROJECT *)
2 : monnier 159 (* monnier@cs.yale.edu *)
3 : monnier 121
4 :     signature COLLECT =
5 :     sig
6 : monnier 185 type info
7 : monnier 121
8 : monnier 159 (* Collect information about variables and function uses.
9 :     * The info is accumulated in the map `m' *)
10 : monnier 164 val collect : FLINT.fundec -> FLINT.fundec
11 : monnier 121
12 : monnier 186 val get : FLINT.lvar -> info
13 : monnier 185
14 : monnier 121 (* query functions *)
15 : monnier 186 val escaping : info -> bool (* non-call uses *)
16 :     val called : info -> bool (* known call uses *)
17 : monnier 189 val dead : info -> bool (* usenb = 0 ? *)
18 :     val usenb : info -> int (* total nb of uses *)
19 : monnier 190 val callnb : info -> int (* total nb of calls *)
20 : monnier 121
21 : monnier 189 (* self-referential (i.e. internal) uses *)
22 :     val iusenb : info -> int
23 :     val icallnb : info -> int
24 :     (* reset to safe values (0 and 0) *)
25 :     val ireset : info -> unit
26 :    
27 : monnier 121 (* inc the "true=call,false=use" count *)
28 : monnier 186 val use : FLINT.value list option -> info -> unit
29 : monnier 187 (* dec the "true=call,false=use" count and return true if zero *)
30 :     val unuse : bool -> info -> bool
31 : monnier 121 (* transfer the counts of var1 to var2 *)
32 :     val transfer : FLINT.lvar * FLINT.lvar -> unit
33 :     (* add the counts of var1 to var2 *)
34 : monnier 186 (* val addto : info * info -> unit *)
35 : monnier 121 (* delete the last reference to a variable *)
36 : monnier 187 (* val kill : FLINT.lvar -> unit *)
37 : monnier 164 (* create a new var entry (SOME arg list if fun) initialized to zero *)
38 : monnier 186 val new : FLINT.lvar list option -> FLINT.lvar -> info
39 : monnier 121
40 :     (* when creating a new var. Used when alpha-renaming *)
41 :     (* val copy : FLINT.lvar * FLINT.lvar -> unit *)
42 :    
43 : monnier 159 (* fix up function to keep counts up-to-date when getting rid of code.
44 : monnier 187 * the arg is called for *free* variables becoming dead. *)
45 :     val unuselexp : (FLINT.lvar -> unit) -> FLINT.lexp -> unit
46 : monnier 121 (* function to collect info about a newly created lexp *)
47 : monnier 186 val uselexp : FLINT.lexp -> unit
48 :     (* function to copy (and collect info) a lexp *)
49 : monnier 164 val copylexp : FLINT.lvar IntmapF.intmap -> FLINT.lexp -> FLINT.lexp
50 : monnier 121
51 :     (* mostly useful for PPFlint *)
52 :     val LVarString : FLINT.lvar -> string
53 :     end
54 :    
55 : monnier 164 (* Internal vs External references:
56 :     * I started with a version that kept track separately of internal and external
57 :     * uses. This has the advantage that if the extuses count goes to zero, we can
58 :     * consider the function as dead. Without this, recursive functions can never
59 :     * be recognized as dead during fcontract (they are still eliminated at the
60 :     * beginning, tho). This looks nice at first, but poses problems:
61 :     * - when you do simple inlining (just moving the body of the procedure), you
62 :     * may inadvertently turn ext-uses into int-uses. This only happens when
63 : monnier 189 * inlining mutually recursive function, but this can be commen (think of
64 :     * when fcontract undoes a useless uncurrying of a recursive function). This
65 : monnier 164 * can be readily overcome by not using the `move body' optimization in
66 :     * dangerous cases and do the full copy+kill instead.
67 :     * - you have to keep track of what is inside what. The way I did it was to
68 :     * have an 'inside' ref cell in each fun. That was a bad idea. The problem
69 :     * stems from the fact that when you detect that a function becomes dead,
70 :     * you have to somehow reset those `inside' ref cells to reflect the location
71 :     * of the function before you can uncount its references. In most cases, this
72 :     * is unnecessary, but it is necessary when undertaking a function mutually
73 :     * recursive with a function in which you currently are when you detect the
74 :     * function's death.
75 : monnier 189 * rather than fix this last point, I decided to give up on keeping internal
76 :     * counts up-to-date. Instead, I just compute them once during collect and
77 :     * never touch them again: this means that they should not be relied on in
78 :     * general. More specifically, they become potentially invalid as soon as
79 :     * the body of the function is changed. This still allows their use in
80 :     * many cases.
81 : monnier 164 *)
82 :    
83 : monnier 121 structure Collect :> COLLECT =
84 :     struct
85 :     local
86 :     structure F = FLINT
87 :     structure M = Intmap
88 : monnier 186 structure FU = FlintUtil
89 : monnier 121 structure LV = LambdaVar
90 :     structure PP = PPFlint
91 : monnier 202 structure PO = PrimOp
92 : monnier 121 in
93 :    
94 :     val say = Control.Print.say
95 :     fun bug msg = ErrorMsg.impossible ("Collect: "^msg)
96 :     fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)
97 :     fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
98 :    
99 : monnier 189 datatype info
100 : monnier 187 (* we keep track of calls and escaping uses *)
101 : monnier 190 = Info of {calls: int ref, uses: int ref, int: (int * int) ref}
102 : monnier 121
103 :     exception NotFound
104 :    
105 : monnier 186 val m : info M.intmap = M.new(128, NotFound)
106 : monnier 121
107 : monnier 189 fun new args lv =
108 : monnier 190 let val i = Info{uses=ref 0, calls=ref 0, int=ref(0,0)}
109 : monnier 189 in M.add m (lv, i); i
110 :     end
111 :    
112 : monnier 121 (* map related helper functions *)
113 :     fun get lv = (M.map m lv)
114 : monnier 202 handle x as NotFound =>
115 : monnier 186 (say ("Collect: ERROR: get unknown var "^
116 :     (LV.lvarName lv)^
117 :     ". Pretending dead...\n");
118 :     (* raise x; *)
119 : monnier 202 new NONE lv)
120 : monnier 121
121 :     fun LVarString lv =
122 : monnier 189 let val Info{uses=ref uses,calls=ref calls,...} = get lv
123 : monnier 187 in (LV.lvarName lv)^
124 :     "{"^(Int.toString uses)^
125 :     (if calls > 0 then ","^(Int.toString calls) else "")^"}"
126 :     end
127 :    
128 : monnier 121 (* adds the counts of lv1 to those of lv2 *)
129 : monnier 189 fun addto (Info{uses=uses1,calls=calls1,...},Info{uses=uses2,calls=calls2,...}) =
130 : monnier 187 (uses2 := !uses2 + !uses1; calls2 := !calls2 + !calls1)
131 :    
132 : monnier 121 fun transfer (lv1,lv2) =
133 : monnier 187 let val i1 = get lv1
134 :     val i2 = get lv2
135 :     in addto(i1, i2);
136 :     (* note the transfer by redirecting the map *)
137 :     M.add m (lv1, i2)
138 :     end
139 : monnier 121
140 :     fun inc ri = (ri := !ri + 1)
141 :     fun dec ri = (ri := !ri - 1)
142 :    
143 : monnier 164 (* - first list is list of formal args
144 :     * - second is list of `up to know known arg'
145 :     * - third is args of the current call. *)
146 :     fun mergearg (NONE,a) = NONE
147 :     | mergearg (SOME(fv,NONE),a) =
148 :     if a = F.VAR fv then SOME(fv,NONE) else SOME(fv,SOME a)
149 :     | mergearg (SOME(fv,SOME b),a) =
150 :     if a = b orelse a = F.VAR fv then SOME(fv,SOME b) else NONE
151 :    
152 : monnier 190 fun use call (Info{uses,calls,...}) =
153 : monnier 187 (inc uses;
154 :     case call
155 : monnier 190 of NONE => ()
156 : monnier 187 | SOME vals =>
157 : monnier 190 inc calls)
158 : monnier 121
159 : monnier 189 fun unuse call (Info{uses,calls,...}) =
160 : monnier 187 (* notice the calls could be dec'd to negative values because a
161 :     * use might be turned from escaping to known between the census
162 :     * and the unuse. We can't easily detect such changes, but
163 :     * we can detect it happened when we try to go below zero. *)
164 :     (dec uses;
165 : monnier 189 if (call (* andalso !calls > 0 *)) then dec calls
166 : monnier 199 else ();
167 : monnier 187 if !uses < 0 then bug "decrementing too much" (* F.VAR lv) *)
168 :     else !uses = 0)
169 : monnier 121
170 : monnier 189 fun usenb (Info{uses=ref uses,...}) = uses
171 : monnier 190 fun callnb (Info{calls=ref calls,...}) = calls
172 : monnier 189 fun used (Info{uses,...}) = !uses > 0
173 :     fun dead (Info{uses,...}) = !uses = 0
174 :     fun escaping (Info{uses,calls,...}) = !uses > !calls
175 :     fun called (Info{calls,...}) = !calls > 0
176 :     fun iusenb (Info{int=ref(u,_),...}) = u
177 :     fun icallnb (Info{int=ref(_,c),...}) = c
178 :     fun ireset (Info{int,...}) = int := (0,0)
179 : monnier 164
180 : monnier 121 (* Ideally, we should check that usenb = 1, but we may have been a bit
181 :     * conservative when keeping the counts uptodate *)
182 : monnier 199 fun kill lv = (M.rmv m lv)
183 : monnier 121
184 : monnier 164 (* ********************************************************************** *)
185 :     (* ********************************************************************** *)
186 : monnier 121
187 : monnier 164 datatype usage
188 :     = All
189 :     | None
190 :     | Some of bool list
191 : monnier 121
192 : monnier 164 fun usage bs =
193 :     let fun ua [] = All
194 :     | ua (false::_) = Some bs
195 :     | ua (true::bs) = ua bs
196 :     fun un [] = None
197 :     | un (true::_) = Some bs
198 :     | un (false::bs) = un bs
199 :     in case bs
200 :     of true::bs => ua bs
201 :     | false::bs => un bs
202 :     | [] => None
203 :     end
204 : monnier 121
205 : monnier 202 fun impurePO (po:F.primop) = not(PO.purePrimop (#2 po))
206 : monnier 121
207 : monnier 186 val census = let
208 :     (* val use = if inc then use else unuse *)
209 : monnier 187 fun call args lv = use args (get lv)
210 :     val use = fn F.VAR lv => use NONE (get lv) | _ => ()
211 : monnier 186 fun newv lv = new NONE lv
212 :     fun newf args lv = new args lv
213 :     fun id x = x
214 : monnier 121
215 : monnier 186 (* here, the use resembles a call, but it's safer to consider it as a use *)
216 :     fun cpo (NONE:F.dict option,po,lty,tycs) = ()
217 :     | cpo (SOME{default,table},po,lty,tycs) =
218 :     (use (F.VAR default); app (use o F.VAR o #2) table)
219 :     fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = use (F.VAR lv)
220 :     | cdcon _ = ()
221 : monnier 121
222 : monnier 186 (* the actual function:
223 :     * `uvs' is an optional list of booleans representing which of
224 :     * the return values are actually used *)
225 : monnier 189 fun cexp lexp =
226 : monnier 199 case lexp
227 : monnier 186 of F.RET vs => app use vs
228 : monnier 121
229 : monnier 186 | F.LET (lvs,le1,le2) =>
230 :     let val lvsi = map newv lvs
231 : monnier 189 in cexp le2; cexp le1
232 : monnier 186 end
233 : monnier 121
234 : monnier 186 | F.FIX (fs,le) =>
235 :     let val fs = map (fn (_,f,args,body) =>
236 :     (newf (SOME(map #1 args)) f,args,body))
237 :     fs
238 : monnier 189 fun cfun (Info{uses,calls, int, ...}, args,body) =
239 :     (* census of a fundec. We get the internal counts
240 :     * by examining the count difference between before
241 :     * and after census of the body. *)
242 :     let val (euses,ecalls) = (!uses,!calls)
243 :     in
244 :     app (fn (v,t) => ignore(newv v)) args;
245 :     cexp body;
246 :     int := (!uses - euses, !calls - ecalls)
247 :     end
248 : monnier 186 fun cfix fs = (* census of a list of fundecs *)
249 :     let val (ufs,nfs) = List.partition (used o #1) fs
250 :     in if List.null ufs then ()
251 :     else (app cfun ufs; cfix nfs)
252 :     end
253 : monnier 189 in cexp le; cfix fs
254 : monnier 186 end
255 :    
256 :     | F.APP (F.VAR f,vs) =>
257 :     (call (SOME vs) f; app use vs)
258 : monnier 121
259 : monnier 186 | F.TFN ((tf,args,body),le) =>
260 : monnier 202 let val tfi = newf (SOME[]) tf
261 : monnier 189 in cexp le; if used tfi then cexp body else ()
262 : monnier 186 end
263 : monnier 164
264 : monnier 202 | F.TAPP (F.VAR tf,tycs) => call (SOME[]) tf
265 : monnier 164
266 : monnier 186 | F.SWITCH (v,cs,arms,def) =>
267 : monnier 189 (use v; Option.map cexp def;
268 :     app (fn (F.DATAcon(dc,_,lv),le) => (cdcon dc; newv lv; cexp le)
269 :     | (_,le) => cexp le)
270 : monnier 186 arms)
271 :    
272 :     | F.CON (dc,_,v,lv,le) =>
273 :     let val lvi = newv lv
274 : monnier 189 in cdcon dc; cexp le; if used lvi then use v else ()
275 : monnier 186 end
276 : monnier 164
277 : monnier 186 | F.RECORD (_,vs,lv,le) =>
278 :     let val lvi = newv lv
279 : monnier 189 in cexp le; if used lvi then app use vs else ()
280 : monnier 186 end
281 : monnier 164
282 : monnier 186 | F.SELECT (v,_,lv,le) =>
283 :     let val lvi = newv lv
284 : monnier 189 in cexp le; if used lvi then use v else ()
285 : monnier 186 end
286 : monnier 164
287 : monnier 186 | F.RAISE (v,_) => use v
288 : monnier 189 | F.HANDLE (le,v) => (use v; cexp le)
289 : monnier 186
290 :     | F.BRANCH (po,vs,le1,le2) =>
291 : monnier 189 (app use vs; cpo po; cexp le1; cexp le2)
292 : monnier 186
293 :     | F.PRIMOP (po,vs,lv,le) =>
294 :     let val lvi = newv lv
295 : monnier 202 in cexp le;
296 :     if used lvi orelse impurePO po then (cpo po; app use vs) else ()
297 : monnier 186 end
298 :    
299 : monnier 199 | le => buglexp("unexpected lexp", le)
300 : monnier 186 in
301 :     cexp
302 : monnier 121 end
303 :    
304 :     (* The code is almost the same for uncounting, except that calling
305 :     * undertaker should not be done for non-free variables. For that we
306 :     * artificially increase the usage count of each variable when it's defined
307 :     * (accomplished via the "def" calls)
308 :     * so that its counter never reaches 0 while processing its scope.
309 :     * Once its scope has been processed, we can completely get rid of
310 :     * the variable and corresponding info (after verifying that the count
311 :     * is indeed exactly 1 (accomplished by the "kill" calls) *)
312 : monnier 159 fun unuselexp undertaker = let
313 : monnier 121 (* val use = if inc then use else unuse *)
314 : monnier 187 fun uncall lv = if unuse true (get lv) then undertaker lv else ()
315 :     val unuse = fn F.VAR lv => if unuse false (get lv) then undertaker lv else ()
316 :     | _ => ()
317 :     fun def i = (use NONE i)
318 : monnier 121 fun id x = x
319 :    
320 :     fun cpo (NONE:F.dict option,po,lty,tycs) = ()
321 :     | cpo (SOME{default,table},po,lty,tycs) =
322 :     (unuse(F.VAR default); app (unuse o F.VAR o #2) table)
323 :     fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = unuse(F.VAR lv)
324 :     | cdcon _ = ()
325 :    
326 : monnier 187 fun cfun (args,body) = (* census of a fundec *)
327 : monnier 199 (app (def o get) args; cexp body; app kill args)
328 : monnier 121
329 :     and cexp lexp =
330 : monnier 199 case lexp
331 : monnier 121 of F.RET vs => app unuse vs
332 :    
333 :     | F.LET (lvs,le1,le2) =>
334 : monnier 187 (app (def o get) lvs; cexp le2; cexp le1; app kill lvs)
335 : monnier 121
336 :     | F.FIX (fs,le) =>
337 : monnier 187 let val fs = map (fn (_,f,args,body) => (get f, f, args, body)) fs
338 :     val usedfs = (List.filter (used o #1) fs)
339 :     in app (def o #1) fs;
340 : monnier 121 cexp le;
341 : monnier 187 app (fn (_,_,args,le) => cfun(map #1 args, le)) usedfs;
342 : monnier 121 app (kill o #2) fs
343 :     end
344 :    
345 :     | F.APP (F.VAR f,vs) =>
346 :     (uncall f; app unuse vs)
347 :    
348 :     | F.TFN ((tf,args,body),le) =>
349 : monnier 187 let val tfi = get tf
350 :     in if used tfi then cexp body else ();
351 :     def tfi; cexp le; kill tf
352 :     end
353 : monnier 121
354 :     | F.TAPP (F.VAR tf,tycs) => uncall tf
355 :    
356 :     | F.SWITCH (v,cs,arms,default) =>
357 :     (unuse v; Option.map cexp default;
358 :     (* here we don't absolutely have to keep track of vars bound within
359 :     * each arm since these vars can't be eliminated anyway *)
360 :     app (fn (F.DATAcon(dc,_,lv),le) =>
361 : monnier 187 (cdcon dc; def(get lv); cexp le; kill lv)
362 : monnier 121 | (_,le) => cexp le)
363 :     arms)
364 :    
365 :     | F.CON (dc,_,v,lv,le) =>
366 : monnier 187 let val lvi = get lv
367 :     in cdcon dc; if used lvi then unuse v else ();
368 :     def lvi; cexp le; kill lv
369 :     end
370 : monnier 121
371 :     | F.RECORD (_,vs,lv,le) =>
372 : monnier 187 let val lvi = get lv
373 :     in if used lvi then app unuse vs else ();
374 :     def lvi; cexp le; kill lv
375 :     end
376 : monnier 121
377 :     | F.SELECT (v,_,lv,le) =>
378 : monnier 187 let val lvi = get lv
379 :     in if used lvi then unuse v else ();
380 :     def lvi; cexp le; kill lv
381 :     end
382 : monnier 121
383 :     | F.RAISE (v,_) => unuse v
384 :     | F.HANDLE (le,v) => (unuse v; cexp le)
385 :    
386 :     | F.BRANCH (po,vs,le1,le2) =>
387 :     (app unuse vs; cpo po; cexp le1; cexp le2)
388 :    
389 :     | F.PRIMOP (po,vs,lv,le) =>
390 : monnier 187 let val lvi = get lv
391 : monnier 202 in if used lvi orelse impurePO po
392 : monnier 187 then (cpo po; app unuse vs)
393 :     else ();
394 :     def lvi; cexp le; kill lv
395 :     end
396 : monnier 121
397 : monnier 199 | le => buglexp("unexpected lexp", le)
398 : monnier 121 in
399 : monnier 187 cexp
400 : monnier 121 end
401 :    
402 : monnier 189 val uselexp = census
403 : monnier 164 fun copylexp alpha le =
404 : monnier 197 let val nle = FU.copy [] alpha le
405 : monnier 186 in uselexp nle; nle
406 : monnier 164 end
407 :    
408 : monnier 121 fun collect (fdec as (_,f,_,_)) =
409 : monnier 186 ((* say "Entering Collect...\n"; *)
410 :     M.clear m; (* start from a fresh state *)
411 : monnier 202 PP.LVarString := LVarString;
412 : monnier 186 uselexp (F.FIX([fdec], F.RET[F.VAR f]));
413 :     (* say "...Collect Done.\n"; *)
414 :     fdec)
415 : monnier 121
416 :     end
417 :     end

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