Annotation of /sml/trunk/src/compiler/FLINT/clos/freemap.sml

Parent Directory | Revision Log

---

Revision 17 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/FLINT/clos/freemap.sml

1 :	monnier	16	(* Copyright 1989 by AT&T Bell Laboratories
2 :			*
3 :			*)
4 :			(* freemap.sml *)
5 :
6 :			signature FREEMAP =
7 :			sig
8 :			val freevars: CPS.cexp -> CPS.lvar list
9 :			val freemap : (CPS.lvar * CPS.lvar list -> unit)
10 :			-> (CPS.cexp -> CPS.lvar list)
11 :			val cexp_freevars: (CPS.lvar->CPS.lvar list)
12 :			-> CPS.cexp -> CPS.lvar list
13 :			val freemapClose : CPS.cexp -> ((CPS.lvar -> CPS.lvar list) *
14 :			(CPS.lvar -> bool) *
15 :			(CPS.lvar -> bool))
16 :			end
17 :
18 :			structure FreeMap : FREEMAP = struct
19 :
20 :			local
21 :			open CPS SortedList
22 :			in
23 :
24 :			fun clean l =
25 :			let fun vars(l, VAR x :: rest) = vars(x::l, rest)
26 :			| vars(l, _::rest) = vars(l,rest)
27 :			| vars(l, nil) = uniq l
28 :			in vars(nil, l)
29 :			end
30 :
31 :			val enter = fn (VAR x,y) => enter(x,y) | (_,y) => y
32 :			val error = ErrorMsg.impossible
33 :
34 :
35 :			(*
36 :			* freevars
37 :			* -- Given a CPS expression, the function "freevars" does a top-down
38 :			* traverse on the CPS expression and returns the set of free variables
39 :			* in the CPS expression.
40 :			*)
41 :			val rec freevars =
42 :			fn APP(v,args) => enter(v,clean args)
43 :			| SWITCH(v,c,l) => enter(v,foldmerge (map freevars l))
44 :			| RECORD(_,l,w,ce) => merge(clean (map #1 l), rmv(w, freevars ce))
45 :			| SELECT(_,v,w,_,ce) => enter(v, rmv(w, freevars ce))
46 :			| OFFSET(_,v,w,ce) => enter(v, rmv(w, freevars ce))
47 :			| SETTER(_,vl,e) => merge(clean vl, freevars e)
48 :			| LOOKER(_,vl,w,_,e) => merge(clean vl, rmv(w, freevars e))
49 :			| ARITH(_,vl,w,_,e) => merge(clean vl, rmv(w, freevars e))
50 :			| PURE(_,vl,w,_,e) => merge(clean vl, rmv(w, freevars e))
51 :			| BRANCH(_,vl,c,e1,e2) => merge(clean vl, merge(freevars e1, freevars e2))
52 :			| FIX(fl,e) =>
53 :			let fun g(_,f,vl,_,ce) = difference(freevars ce, uniq vl)
54 :			in difference(foldmerge (freevars e :: map g fl), uniq(map #2 fl))
55 :			end
56 :
57 :			(*
58 :			* freemap
59 :			* -- This function is used only in those post-globalfix phases. For each
60 :			* newly bound lvar in the CPS expression, a set of lvars which live
61 :			* beyond this lvar are identified. A function is applied to this pair
62 :			* then.
63 :			*)
64 :			fun freemap add =
65 :			let (* Doesn't apply "add" to the rebound variables of a branch *)
66 :			fun setvars (w,free) = let val g = rmv(w,free)
67 :			in add(w,g); g
68 :			end
69 :			val rec freevars =
70 :			fn APP(v,args) => enter(v,clean args)
71 :			| SWITCH(v,c,l) => enter(v,foldmerge (map freevars l))
72 :			| RECORD(_,l,w,ce) => merge(clean (map #1 l),setvars(w,freevars ce))
73 :			| SELECT(_,v,w,_,ce) => enter(v, setvars(w, freevars ce))
74 :			| OFFSET(_,v,w,ce) => enter(v, setvars(w, freevars ce))
75 :			| SETTER(_,vl,e) => merge(clean vl, freevars e)
76 :			| LOOKER(_,vl,w,_,e) => merge(clean vl, setvars(w, freevars e))
77 :			| ARITH(_,vl,w,_,e) => merge(clean vl, setvars(w, freevars e))
78 :			| PURE(_,vl,w,_,e) => merge(clean vl, setvars(w, freevars e))
79 :			| BRANCH(_,vl,c,e1,e2) =>
80 :			let val s = merge(clean vl,merge(freevars e1, freevars e2))
81 :			in add(c,s); s
82 :			end
83 :			| FIX _ => error "FIX in Freemap.freemap"
84 :			in freevars
85 :			end
86 :
87 :			(*
88 :			* cexp_freevars
89 :			* -- To be used in conjunction with FreeMap.freemap.
90 :			* Consequently, raises an exception for FIX. Only used
91 :			* in those post-globalfix phases.
92 :			*)
93 :			fun cexp_freevars lookup cexp =
94 :			let val rec f =
95 :			fn RECORD(_,vl,w,_) => merge(clean(map #1 vl), lookup w)
96 :			| SELECT(_,v,w,_,_) => enter(v, lookup w)
97 :			| OFFSET(_,v,w,_) => enter(v, lookup w)
98 :			| APP(f,vl) => clean (f::vl)
99 :			| FIX _ => error "FIX in Freemap.cexp_freevars"
100 :			| SWITCH(v,c,cl) =>
101 :			enter(v, foldmerge (map f cl))
102 :			| SETTER(_,vl,e) => merge(clean vl, f e)
103 :			| LOOKER(_,vl,w,_,e) => merge(clean vl, lookup w)
104 :			| ARITH(_,vl,w,_,e) => merge(clean vl, lookup w)
105 :			| PURE(_,vl,w,_,e) => merge(clean vl, lookup w)
106 :			| BRANCH(_,vl,c,e1,e2) => merge(clean vl,merge(f e1, f e2))
107 :			in f cexp
108 :			end
109 :
110 :
111 :			(*
112 :			* freemapClose
113 :			* -- Produces a free variable mapping at each function binding.
114 :			* The mapping includes the functions bound at the FIX, but
115 :			* not the arguments of the function.
116 :			* Only used in the closure phase.
117 :			*)
118 :			fun freemapClose ce =
119 :			let exception Freemap
120 :			val vars : lvar list Intmap.intmap = Intmap.new(32, Freemap)
121 :			val escapes = Intset.new()
122 :			val escapesP = Intset.mem escapes
123 :			fun escapesM(VAR v) = Intset.add escapes v
124 :			| escapesM _ = ()
125 :			val known = Intset.new()
126 :			val knownM = Intset.add known
127 :			val rec freevars =
128 :			fn FIX(l,ce) =>
129 :			let val functions = uniq(map #2 l)
130 :			(* MUST be done in this order due to side-effects *)
131 :			val freeb = freevars ce
132 :			val freel =
133 :			foldr (fn ((_,v,args,_,body),freel) =>
134 :			(let val l = remove(uniq args,freevars body)
135 :			in Intmap.add vars (v,l);
136 :			l::freel
137 :			end))
138 :			[] l
139 :			in app (fn v => if escapesP v then () else knownM v)
140 :			functions;
141 :			remove(functions,foldmerge(freeb::freel))
142 :			end
143 :			| APP(v,args) => (app escapesM args;
144 :			enter(v, clean args))
145 :			| SWITCH(v,c,l) => foldmerge (clean[v]::(map freevars l))
146 :			| RECORD(_,l,w,ce) => (app (escapesM o #1) l;
147 :			merge(clean (map #1 l), rmv(w,freevars ce)))
148 :			| SELECT(_,v,w,_,ce) => enter(v,rmv(w,freevars ce))
149 :			| OFFSET(_,v,w,ce) => enter(v,rmv(w,freevars ce))
150 :			| LOOKER(_,vl,w,_,ce) => (app escapesM vl;
151 :			merge(clean vl, rmv(w,freevars ce)))
152 :			| ARITH(_,vl,w,_,ce) => (app escapesM vl;
153 :			merge(clean vl, rmv(w,freevars ce)))
154 :			| PURE(_,vl,w,_,ce) => (app escapesM vl;
155 :			merge(clean vl, rmv(w,freevars ce)))
156 :			| SETTER(_,vl,ce) => (app escapesM vl; merge(clean vl, freevars ce))
157 :			| BRANCH(_,vl,c,e1,e2) =>
158 :			(app escapesM vl;
159 :			merge(clean vl,merge(freevars e1, freevars e2)))
160 :			in freevars ce;
161 :			(Intmap.map vars, Intset.mem escapes, Intset.mem known)
162 :			end
163 :
164 :			(* temporary, for debugging
165 :			val phase = Stats.doPhase(Stats.makephase "Compiler 078 Freemap")
166 :			val freemap = phase freemap
167 :			val freemapClose = phase freemapClose
168 :			val freevars = phase freevars
169 :			*)
170 :
171 :			end (* local *)
172 :
173 :			end (* structure FreeMap *)
174 :
175 :
176 :			(*
177 :			* $Log: freemap.sml,v $
178 :			* Revision 1.1.1.1 1997/01/14 01:38:31 george
179 :			* Version 109.24
180 :			*
181 :			*)

---

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