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

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/opt/specialize.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/opt/specialize.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 732, Mon Nov 13 21:59:12 2000 UTC revision 733, Fri Nov 17 05:13:45 2000 UTC
# Line 169  Line 169 
169    
170  type depth = DI.depth  type depth = DI.depth
171  type info = (tyc list * lvar list) list  type info = (tyc list * lvar list) list
172  type itable = info Intmap.intmap   (* lvar -> (tyc list * lvar) *)  type itable = info IntHashTable.hash_table   (* lvar -> (tyc list * lvar) *)
173  type dtable = (depth * dinfo) Intmap.intmap  type dtable = (depth * dinfo) IntHashTable.hash_table
174  datatype infoEnv = IENV of (itable * (tvar * tkind) list) list * dtable  datatype infoEnv = IENV of (itable * (tvar * tkind) list) list * dtable
175    
176  (****************************************************************************  (****************************************************************************
# Line 178  Line 178 
178   ****************************************************************************)   ****************************************************************************)
179  (** initializing a new info environment : unit -> infoEnv *)  (** initializing a new info environment : unit -> infoEnv *)
180  fun initInfoEnv () =  fun initInfoEnv () =
181    let val itable : itable = Intmap.new (32, ITABLE)    let val itable : itable = IntHashTable.mkTable (32, ITABLE)
182        val dtable : dtable = Intmap.new(32, DTABLE)        val dtable : dtable = IntHashTable.mkTable (32, DTABLE)
183     in IENV ([(itable,[])], dtable)     in IENV ([(itable,[])], dtable)
184    end    end
185    
186  (** register a definition of sth interesting into the info environment *)  (** register a definition of sth interesting into the info environment *)
187  fun entDtable (IENV(_, dtable), v, ddinfo) = Intmap.add dtable (v, ddinfo)  fun entDtable (IENV(_, dtable), v, ddinfo) =
188        IntHashTable.insert dtable (v, ddinfo)
189    
190  (** mark an lvar in the dtable as escape *)  (** mark an lvar in the dtable as escape *)
191  fun escDtable (IENV(_, dtable), v) =  fun escDtable (IENV(_, dtable), v) =
192    ((case Intmap.map dtable v      case IntHashTable.find dtable v of
193       of (_, ESCAPE) => ()          SOME (_, ESCAPE) => ()
194        | (d, _) => Intmap.add dtable (v, (d, ESCAPE)))        | SOME (d, _) => IntHashTable.insert dtable (v, (d, ESCAPE))
195     handle _ => ())        | NONE => ()
196    
197  (*  (*
198   * Register a dtable entry; modify the least upper bound of a particular   * Register a dtable entry; modify the least upper bound of a particular
# Line 200  Line 201 
201   *)   *)
202  fun regDtable (IENV(kenv, dtable), v, infos) =  fun regDtable (IENV(kenv, dtable), v, infos) =
203    let val (dd, dinfo) =    let val (dd, dinfo) =
204          ((Intmap.map dtable v) handle _ =>          ((IntHashTable.lookup dtable v) handle _ =>
205                  bug "unexpected cases in regDtable")                  bug "unexpected cases in regDtable")
206     in (case dinfo     in (case dinfo
207          of ESCAPE => ()          of ESCAPE => ()
# Line 212  Line 213 
213                          in CSTR nbnds                          in CSTR nbnds
214                         end                         end
215                   val ndinfo = foldr h dinfo infos                   val ndinfo = foldr h dinfo infos
216                in Intmap.add dtable (v, (dd, ndinfo))                in IntHashTable.insert dtable (v, (dd, ndinfo))
217               end)               end)
218    end (* function regDtable *)    end (* function regDtable *)
219    
# Line 222  Line 223 
223   *)   *)
224  fun sumDtable(IENV(kenv, dtable), v, infos) =  fun sumDtable(IENV(kenv, dtable), v, infos) =
225    let val (dd, dinfo) =    let val (dd, dinfo) =
226          ((Intmap.map dtable v) handle _ =>          ((IntHashTable.lookup dtable v) handle _ =>
227                  bug "unexpected cases in sumDtable")                  bug "unexpected cases in sumDtable")
228     in (case dinfo     in (case dinfo
229          of ESCAPE => (dd, ESCAPE)          of ESCAPE => (dd, ESCAPE)
# Line 244  Line 245 
245  (** look and add a new type instance into the itable *)  (** look and add a new type instance into the itable *)
246  fun lookItable (IENV (itabs,dtab), d, v, ts, getlty, nv_depth) =  fun lookItable (IENV (itabs,dtab), d, v, ts, getlty, nv_depth) =
247    let val (dd, _) =    let val (dd, _) =
248          ((Intmap.map dtab v) handle _ => bug "unexpected cases in lookItable")          ((IntHashTable.lookup dtab v)
249             handle _ => bug "unexpected cases in lookItable")
250    
251        val nd = List.foldr Int.max dd (map nv_depth (tcs_nvars ts))        val nd = List.foldr Int.max dd (map nv_depth (tcs_nvars ts))
252    
# Line 252  Line 254 
254                        bug "unexpected itables in lookItable")                        bug "unexpected itables in lookItable")
255    
256        val nts = map (fn t => LT.tc_adj(t, d, nd)) ts        val nts = map (fn t => LT.tc_adj(t, d, nd)) ts
257        val xi = (Intmap.map itab v) handle _ => []        val xi = getOpt (IntHashTable.find itab v, [])
258    
259        fun h ((ots,xs)::r) = if tcs_eqv(ots, nts) then (map VAR xs) else h r        fun h ((ots,xs)::r) = if tcs_eqv(ots, nts) then (map VAR xs) else h r
260          | h [] = let val oldt = getlty (VAR v)     (*** old type is ok ***)          | h [] = let val oldt = getlty (VAR v)     (*** old type is ok ***)
261                       val bb = LT.lt_inst(oldt, ts)                       val bb = LT.lt_inst(oldt, ts)
262                       val nvs =  map mkv  bb                       val nvs =  map mkv  bb
263                       val _ = Intmap.add itab (v, (nts, nvs)::xi)                       val _ = IntHashTable.insert itab (v, (nts, nvs)::xi)
264                    in map VAR nvs                    in map VAR nvs
265                   end                   end
266     in h xi     in h xi
# Line 266  Line 268 
268    
269  (** push a new layer of type abstraction : infoEnv -> infoEnv *)  (** push a new layer of type abstraction : infoEnv -> infoEnv *)
270  fun pushItable (IENV(itables, dtable), tvks) =  fun pushItable (IENV(itables, dtable), tvks) =
271    let val nt : itable = Intmap.new(32, ITABLE)    let val nt : itable = IntHashTable.mkTable(32, ITABLE)
272     in (IENV((nt,tvks)::itables, dtable))     in (IENV((nt,tvks)::itables, dtable))
273    end    end
274    
# Line 277  Line 279 
279  fun popItable (IENV([], _)) =  fun popItable (IENV([], _)) =
280        bug "unexpected empty information env in popItable"        bug "unexpected empty information env in popItable"
281    | popItable (ienv as IENV((nt,_)::_, _)) =    | popItable (ienv as IENV((nt,_)::_, _)) =
282        let val infos = Intmap.intMapToList nt        let val infos = IntHashTable.listItemsi nt
283            fun h ((v,info), hdr) =            fun h ((v,info), hdr) =
284              let val _ = regDtable(ienv, v, info)              let val _ = regDtable(ienv, v, info)
285                  fun g ((ts, xs), e) = LET(xs, TAPP(VAR v, ts), e)                  fun g ((ts, xs), e) = LET(xs, TAPP(VAR v, ts), e)
# Line 290  Line 292 
292  fun chkOutEsc (IENV([], _), v) =  fun chkOutEsc (IENV([], _), v) =
293        bug "unexpected empty information env in chkOut"        bug "unexpected empty information env in chkOut"
294    | chkOutEsc (ienv as IENV((nt,_)::_, _), v) =    | chkOutEsc (ienv as IENV((nt,_)::_, _), v) =
295        let val info = (Intmap.map nt v) handle _ => []        let val info = getOpt (IntHashTable.find nt v, [])
296            fun g ((ts, xs), e) = LET(xs, TAPP(VAR v, ts), e)            fun g ((ts, xs), e) = LET(xs, TAPP(VAR v, ts), e)
297            val hdr = fn e => foldr g e info            val hdr = fn e => foldr g e info
298            val _ = Intmap.rmv nt v  (* so that v won't be considered again *)        in
299         in hdr            (* remove this v so it won't be considered again *)
300              ignore (IntHashTable.remove nt v) handle _ => ();
301              hdr
302        end        end
303    
304  fun chkOutEscs (ienv, vs) =  fun chkOutEscs (ienv, vs) =
# Line 308  Line 312 
312        bug "unexpected empty information env in chkOut"        bug "unexpected empty information env in chkOut"
313    
314    | chkOutNorm (ienv as IENV((nt,_)::_, dtable), v, oks, d) =    | chkOutNorm (ienv as IENV((nt,_)::_, dtable), v, oks, d) =
315        let val info = (Intmap.map nt v) handle _ => []        let val info = getOpt (IntHashTable.find nt v, [])
316            val (_, dinfo) = sumDtable(ienv, v, info)            val (_, dinfo) = sumDtable(ienv, v, info)
317            val spinfo =            val spinfo =
318              (case dinfo              (case dinfo
# Line 330  Line 334 
334                     end                     end
335                 | _ => LET(xs, TAPP(VAR v, ts), e))                 | _ => LET(xs, TAPP(VAR v, ts), e))
336            val hdr = fn e => foldr mkhdr e info            val hdr = fn e => foldr mkhdr e info
337            val _ = Intmap.rmv nt v  (* so that v won't be considered again *)            (* don't consider it again... *)
338              val _ = IntHashTable.remove nt v handle _ => []
339         in (hdr, spinfo)         in (hdr, spinfo)
340        end        end
341    

Legend:
Removed from v.732  
changed lines
  Added in v.733

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