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/branches/SMLNJ/src/compiler/FLINT/clos/freemap.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/FLINT/clos/freemap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)
Original Path: sml/trunk/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