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

Parent Directory | Revision Log

---

Revision 204 - (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	204	fun impurePO (po:F.primop) = PO.effect (#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