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 199 - (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 :     in
92 :    
93 :     val say = Control.Print.say
94 :     fun bug msg = ErrorMsg.impossible ("Collect: "^msg)
95 :     fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)
96 :     fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
97 :    
98 : monnier 189 datatype info
99 : monnier 187 (* we keep track of calls and escaping uses *)
100 : monnier 190 = Info of {calls: int ref, uses: int ref, int: (int * int) ref}
101 : monnier 121
102 :     exception NotFound
103 :    
104 : monnier 186 val m : info M.intmap = M.new(128, NotFound)
105 : monnier 121
106 : monnier 189 fun new args lv =
107 : monnier 190 let val i = Info{uses=ref 0, calls=ref 0, int=ref(0,0)}
108 : monnier 189 in M.add m (lv, i); i
109 :     end
110 :    
111 : monnier 121 (* map related helper functions *)
112 :     fun get lv = (M.map m lv)
113 : monnier 199 (* handle x as NotFound =>
114 : monnier 186 (say ("Collect: ERROR: get unknown var "^
115 :     (LV.lvarName lv)^
116 :     ". Pretending dead...\n");
117 :     (* raise x; *)
118 : monnier 199 new NONE lv) *)
119 : monnier 121
120 :     fun LVarString lv =
121 : monnier 189 let val Info{uses=ref uses,calls=ref calls,...} = get lv
122 : monnier 187 in (LV.lvarName lv)^
123 :     "{"^(Int.toString uses)^
124 :     (if calls > 0 then ","^(Int.toString calls) else "")^"}"
125 :     end
126 :    
127 : monnier 121 (* adds the counts of lv1 to those of lv2 *)
128 : monnier 189 fun addto (Info{uses=uses1,calls=calls1,...},Info{uses=uses2,calls=calls2,...}) =
129 : monnier 187 (uses2 := !uses2 + !uses1; calls2 := !calls2 + !calls1)
130 :    
131 : monnier 121 fun transfer (lv1,lv2) =
132 : monnier 187 let val i1 = get lv1
133 :     val i2 = get lv2
134 :     in addto(i1, i2);
135 :     (* note the transfer by redirecting the map *)
136 :     M.add m (lv1, i2)
137 :     end
138 : monnier 121
139 :     fun inc ri = (ri := !ri + 1)
140 :     fun dec ri = (ri := !ri - 1)
141 :    
142 : monnier 164 (* - first list is list of formal args
143 :     * - second is list of `up to know known arg'
144 :     * - third is args of the current call. *)
145 :     fun mergearg (NONE,a) = NONE
146 :     | mergearg (SOME(fv,NONE),a) =
147 :     if a = F.VAR fv then SOME(fv,NONE) else SOME(fv,SOME a)
148 :     | mergearg (SOME(fv,SOME b),a) =
149 :     if a = b orelse a = F.VAR fv then SOME(fv,SOME b) else NONE
150 :    
151 : monnier 190 fun use call (Info{uses,calls,...}) =
152 : monnier 187 (inc uses;
153 :     case call
154 : monnier 190 of NONE => ()
155 : monnier 187 | SOME vals =>
156 : monnier 190 inc calls)
157 : monnier 121
158 : monnier 189 fun unuse call (Info{uses,calls,...}) =
159 : monnier 187 (* notice the calls could be dec'd to negative values because a
160 :     * use might be turned from escaping to known between the census
161 :     * and the unuse. We can't easily detect such changes, but
162 :     * we can detect it happened when we try to go below zero. *)
163 :     (dec uses;
164 : monnier 189 if (call (* andalso !calls > 0 *)) then dec calls
165 : monnier 199 else ();
166 : monnier 187 if !uses < 0 then bug "decrementing too much" (* F.VAR lv) *)
167 :     else !uses = 0)
168 : monnier 121
169 : monnier 189 fun usenb (Info{uses=ref uses,...}) = uses
170 : monnier 190 fun callnb (Info{calls=ref calls,...}) = calls
171 : monnier 189 fun used (Info{uses,...}) = !uses > 0
172 :     fun dead (Info{uses,...}) = !uses = 0
173 :     fun escaping (Info{uses,calls,...}) = !uses > !calls
174 :     fun called (Info{calls,...}) = !calls > 0
175 :     fun iusenb (Info{int=ref(u,_),...}) = u
176 :     fun icallnb (Info{int=ref(_,c),...}) = c
177 :     fun ireset (Info{int,...}) = int := (0,0)
178 : monnier 164
179 : monnier 121 (* Ideally, we should check that usenb = 1, but we may have been a bit
180 :     * conservative when keeping the counts uptodate *)
181 : monnier 199 fun kill lv = (M.rmv m lv)
182 : monnier 121
183 : monnier 164 (* ********************************************************************** *)
184 :     (* ********************************************************************** *)
185 : monnier 121
186 : monnier 164 datatype usage
187 :     = All
188 :     | None
189 :     | Some of bool list
190 : monnier 121
191 : monnier 164 fun usage bs =
192 :     let fun ua [] = All
193 :     | ua (false::_) = Some bs
194 :     | ua (true::bs) = ua bs
195 :     fun un [] = None
196 :     | un (true::_) = Some bs
197 :     | un (false::bs) = un bs
198 :     in case bs
199 :     of true::bs => ua bs
200 :     | false::bs => un bs
201 :     | [] => None
202 :     end
203 : monnier 121
204 : monnier 164 fun impurePO po = true (* if a PrimOP is pure or not *)
205 : monnier 121
206 : monnier 186 val census = let
207 :     (* val use = if inc then use else unuse *)
208 : monnier 187 fun call args lv = use args (get lv)
209 :     val use = fn F.VAR lv => use NONE (get lv) | _ => ()
210 : monnier 186 fun newv lv = new NONE lv
211 :     fun newf args lv = new args lv
212 :     fun id x = x
213 : monnier 121
214 : monnier 186 fun impurePO po = true (* if a PrimOP is pure or not *)
215 : monnier 121
216 : monnier 186 (* here, the use resembles a call, but it's safer to consider it as a use *)
217 :     fun cpo (NONE:F.dict option,po,lty,tycs) = ()
218 :     | cpo (SOME{default,table},po,lty,tycs) =
219 :     (use (F.VAR default); app (use o F.VAR o #2) table)
220 :     fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = use (F.VAR lv)
221 :     | cdcon _ = ()
222 : monnier 121
223 : monnier 186 (* the actual function:
224 :     * `uvs' is an optional list of booleans representing which of
225 :     * the return values are actually used *)
226 : monnier 189 fun cexp lexp =
227 : monnier 199 case lexp
228 : monnier 186 of F.RET vs => app use vs
229 : monnier 121
230 : monnier 186 | F.LET (lvs,le1,le2) =>
231 :     let val lvsi = map newv lvs
232 : monnier 189 in cexp le2; cexp le1
233 : monnier 186 end
234 : monnier 121
235 : monnier 186 | F.FIX (fs,le) =>
236 :     let val fs = map (fn (_,f,args,body) =>
237 :     (newf (SOME(map #1 args)) f,args,body))
238 :     fs
239 : monnier 189 fun cfun (Info{uses,calls, int, ...}, args,body) =
240 :     (* census of a fundec. We get the internal counts
241 :     * by examining the count difference between before
242 :     * and after census of the body. *)
243 :     let val (euses,ecalls) = (!uses,!calls)
244 :     in
245 :     app (fn (v,t) => ignore(newv v)) args;
246 :     cexp body;
247 :     int := (!uses - euses, !calls - ecalls)
248 :     end
249 : monnier 186 fun cfix fs = (* census of a list of fundecs *)
250 :     let val (ufs,nfs) = List.partition (used o #1) fs
251 :     in if List.null ufs then ()
252 :     else (app cfun ufs; cfix nfs)
253 :     end
254 : monnier 189 in cexp le; cfix fs
255 : monnier 186 end
256 :    
257 :     | F.APP (F.VAR f,vs) =>
258 :     (call (SOME vs) f; app use vs)
259 : monnier 121
260 : monnier 186 | F.TFN ((tf,args,body),le) =>
261 :     let val tfi = newf NONE tf
262 : monnier 189 in cexp le; if used tfi then cexp body else ()
263 : monnier 186 end
264 : monnier 164
265 : monnier 186 | F.TAPP (F.VAR tf,tycs) => call NONE tf
266 : monnier 164
267 : monnier 186 | F.SWITCH (v,cs,arms,def) =>
268 : monnier 189 (use v; Option.map cexp def;
269 :     app (fn (F.DATAcon(dc,_,lv),le) => (cdcon dc; newv lv; cexp le)
270 :     | (_,le) => cexp le)
271 : monnier 186 arms)
272 :    
273 :     | F.CON (dc,_,v,lv,le) =>
274 :     let val lvi = newv lv
275 : monnier 189 in cdcon dc; cexp le; if used lvi then use v else ()
276 : monnier 186 end
277 : monnier 164
278 : monnier 186 | F.RECORD (_,vs,lv,le) =>
279 :     let val lvi = newv lv
280 : monnier 189 in cexp le; if used lvi then app use vs else ()
281 : monnier 186 end
282 : monnier 164
283 : monnier 186 | F.SELECT (v,_,lv,le) =>
284 :     let val lvi = newv lv
285 : monnier 189 in cexp le; if used lvi then use v else ()
286 : monnier 186 end
287 : monnier 164
288 : monnier 186 | F.RAISE (v,_) => use v
289 : monnier 189 | F.HANDLE (le,v) => (use v; cexp le)
290 : monnier 186
291 :     | F.BRANCH (po,vs,le1,le2) =>
292 : monnier 189 (app use vs; cpo po; cexp le1; cexp le2)
293 : monnier 186
294 :     | F.PRIMOP (po,vs,lv,le) =>
295 :     let val lvi = newv lv
296 : monnier 189 in cexp le;
297 : monnier 186 if impurePO po orelse used lvi then (cpo po; app use vs) else ()
298 :     end
299 :    
300 : monnier 199 | le => buglexp("unexpected lexp", le)
301 : monnier 186 in
302 :     cexp
303 : monnier 121 end
304 :    
305 :     (* The code is almost the same for uncounting, except that calling
306 :     * undertaker should not be done for non-free variables. For that we
307 :     * artificially increase the usage count of each variable when it's defined
308 :     * (accomplished via the "def" calls)
309 :     * so that its counter never reaches 0 while processing its scope.
310 :     * Once its scope has been processed, we can completely get rid of
311 :     * the variable and corresponding info (after verifying that the count
312 :     * is indeed exactly 1 (accomplished by the "kill" calls) *)
313 : monnier 159 fun unuselexp undertaker = let
314 : monnier 121 (* val use = if inc then use else unuse *)
315 : monnier 187 fun uncall lv = if unuse true (get lv) then undertaker lv else ()
316 :     val unuse = fn F.VAR lv => if unuse false (get lv) then undertaker lv else ()
317 :     | _ => ()
318 :     fun def i = (use NONE i)
319 : monnier 121 fun id x = x
320 :    
321 :     fun cpo (NONE:F.dict option,po,lty,tycs) = ()
322 :     | cpo (SOME{default,table},po,lty,tycs) =
323 :     (unuse(F.VAR default); app (unuse o F.VAR o #2) table)
324 :     fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = unuse(F.VAR lv)
325 :     | cdcon _ = ()
326 :    
327 : monnier 187 fun cfun (args,body) = (* census of a fundec *)
328 : monnier 199 (app (def o get) args; cexp body; app kill args)
329 : monnier 121
330 :     and cexp lexp =
331 : monnier 199 case lexp
332 : monnier 121 of F.RET vs => app unuse vs
333 :    
334 :     | F.LET (lvs,le1,le2) =>
335 : monnier 187 (app (def o get) lvs; cexp le2; cexp le1; app kill lvs)
336 : monnier 121
337 :     | F.FIX (fs,le) =>
338 : monnier 187 let val fs = map (fn (_,f,args,body) => (get f, f, args, body)) fs
339 :     val usedfs = (List.filter (used o #1) fs)
340 :     in app (def o #1) fs;
341 : monnier 121 cexp le;
342 : monnier 187 app (fn (_,_,args,le) => cfun(map #1 args, le)) usedfs;
343 : monnier 121 app (kill o #2) fs
344 :     end
345 :    
346 :     | F.APP (F.VAR f,vs) =>
347 :     (uncall f; app unuse vs)
348 :    
349 :     | F.TFN ((tf,args,body),le) =>
350 : monnier 187 let val tfi = get tf
351 :     in if used tfi then cexp body else ();
352 :     def tfi; cexp le; kill tf
353 :     end
354 : monnier 121
355 :     | F.TAPP (F.VAR tf,tycs) => uncall tf
356 :    
357 :     | F.SWITCH (v,cs,arms,default) =>
358 :     (unuse v; Option.map cexp default;
359 :     (* here we don't absolutely have to keep track of vars bound within
360 :     * each arm since these vars can't be eliminated anyway *)
361 :     app (fn (F.DATAcon(dc,_,lv),le) =>
362 : monnier 187 (cdcon dc; def(get lv); cexp le; kill lv)
363 : monnier 121 | (_,le) => cexp le)
364 :     arms)
365 :    
366 :     | F.CON (dc,_,v,lv,le) =>
367 : monnier 187 let val lvi = get lv
368 :     in cdcon dc; if used lvi then unuse v else ();
369 :     def lvi; cexp le; kill lv
370 :     end
371 : monnier 121
372 :     | F.RECORD (_,vs,lv,le) =>
373 : monnier 187 let val lvi = get lv
374 :     in if used lvi then app unuse vs else ();
375 :     def lvi; cexp le; kill lv
376 :     end
377 : monnier 121
378 :     | F.SELECT (v,_,lv,le) =>
379 : monnier 187 let val lvi = get lv
380 :     in if used lvi then unuse v else ();
381 :     def lvi; cexp le; kill lv
382 :     end
383 : monnier 121
384 :     | F.RAISE (v,_) => unuse v
385 :     | F.HANDLE (le,v) => (unuse v; cexp le)
386 :    
387 :     | F.BRANCH (po,vs,le1,le2) =>
388 :     (app unuse vs; cpo po; cexp le1; cexp le2)
389 :    
390 :     | F.PRIMOP (po,vs,lv,le) =>
391 : monnier 187 let val lvi = get lv
392 :     in if impurePO po orelse used lvi
393 :     then (cpo po; app unuse vs)
394 :     else ();
395 :     def lvi; cexp le; kill lv
396 :     end
397 : monnier 121
398 : monnier 199 | le => buglexp("unexpected lexp", le)
399 : monnier 121 in
400 : monnier 187 cexp
401 : monnier 121 end
402 :    
403 : monnier 189 val uselexp = census
404 : monnier 164 fun copylexp alpha le =
405 : monnier 197 let val nle = FU.copy [] alpha le
406 : monnier 186 in uselexp nle; nle
407 : monnier 164 end
408 :    
409 : monnier 121 fun collect (fdec as (_,f,_,_)) =
410 : monnier 186 ((* say "Entering Collect...\n"; *)
411 :     M.clear m; (* start from a fresh state *)
412 : monnier 199 (* PP.LVarString := LVarString; *)
413 : monnier 186 uselexp (F.FIX([fdec], F.RET[F.VAR f]));
414 :     (* say "...Collect Done.\n"; *)
415 :     fdec)
416 : monnier 121
417 :     end
418 :     end

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