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/cpsopt/contract.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/cpsopt/contract.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 36  Line 36 
36    
37  signature CONTRACT = sig  signature CONTRACT = sig
38    val contract : {function: CPS.function,    val contract : {function: CPS.function,
39                    table: LtyDef.lty Intmap.intmap,                    table: LtyDef.lty IntHashTable.hash_table,
40                    click: string -> unit,                    click: string -> unit,
41                    last: bool,                    last: bool,
42                    size: int ref}                    size: int ref}
# Line 216  Line 216 
216                    fn t => t))                    fn t => t))
217    | argLty r = LT.ltc_str r (* this is INCORRECT !!!!!!! *)    | argLty r = LT.ltc_str r (* this is INCORRECT !!!!!!! *)
218    
219  val addty = if type_flag then Intmap.add table else (fn _ => ())  val addty = if type_flag then IntHashTable.insert table else (fn _ => ())
220    
221  in  in
222    
223  (* Only used when dropping args in reduce(FIX) case. *)  (* Only used when dropping args in reduce(FIX) case. *)
224  fun getty v =  fun getty v =
225    if type_flag then    if type_flag then
226               (Intmap.map table v) handle _ =>               (IntHashTable.lookup table v) handle _ =>
227                     (Control.Print.say ("NCONTRACT: Can't find the variable "^                     (Control.Print.say ("NCONTRACT: Can't find the variable "^
228                              (Int.toString v)^" in the table ***** \n");                              (Int.toString v)^" in the table ***** \n");
229                      raise NCONTRACT)                      raise NCONTRACT)
# Line 238  Line 238 
238    in  if type_flag then g u    in  if type_flag then g u
239        else LT.ltc_void        else LT.ltc_void
240    end    end
241  fun newty(f,t) = if type_flag then (Intmap.rmv table f; addty(f,t)) else ()  fun newty(f,t) = if type_flag then
242                         (ignore (IntHashTable.remove table f) handle _ => ();
243                          addty(f,t))
244                     else ()
245  fun mkv(t) = let val v = LV.mkLvar()  fun mkv(t) = let val v = LV.mkLvar()
246                   val _ = addty(v,t)                   val _ = addty(v,t)
247               in  v               in  v
# Line 270  Line 273 
273    
274    
275  local exception UsageMap  local exception UsageMap
276  in  val m : {info: info, used : int ref, called : int ref} Intmap.intmap =  in  val m : {info: info, used : int ref, called : int ref}
277                    Intmap.new(128, UsageMap)                  IntHashTable.hash_table =
278      val get = fn i => Intmap.map m i                  IntHashTable.mkTable(128, UsageMap)
279        val get = fn i => IntHashTable.lookup m i
280                  handle UsageMap => bug ("UsageMap on " ^ Int.toString i)                  handle UsageMap => bug ("UsageMap on " ^ Int.toString i)
281      val enter = Intmap.add m      val enter = IntHashTable.insert m
282      val rmv = Intmap.rmv m      fun rmv i = ignore (IntHashTable.remove m i) handle _ => ()
283  end  end
284    
285  fun use(VAR v) = inc(#used(get v))  fun use(VAR v) = inc(#used(get v))
# Line 403  Line 407 
407    
408  local  local
409     exception Beta     exception Beta
410     val m2 : value Intmap.intmap = Intmap.new(32, Beta)     val m2 : value IntHashTable.hash_table = IntHashTable.mkTable(32, Beta)
411     val mapm2 = Intmap.map m2     val mapm2 = IntHashTable.lookup m2
412  in  in
413    
414  fun ren(v0 as VAR v) = (ren(mapm2 v) handle Beta => v0)  fun ren(v0 as VAR v) = (ren(mapm2 v) handle Beta => v0)
# Line 420  Line 424 
424         | f _ = ()         | f _ = ()
425   in  if deadup then f (ren w) else ();   in  if deadup then f (ren w) else ();
426       rmv v;       rmv v;
427       sameLty vw; sameName vw; Intmap.add m2 vw       sameLty vw; sameName vw; IntHashTable.insert m2 vw
428   end   end
429    
430  end (* local *)  end (* local *)
# Line 1029  Line 1033 
1033  in  debugprint "Contract: "; debugflush();  in  debugprint "Contract: "; debugflush();
1034      enterMISC0 fvar; app enterMISC0 fargs;      enterMISC0 fvar; app enterMISC0 fargs;
1035      pass1 cexp;      pass1 cexp;
1036      cpssize := Intmap.elems m;      cpssize := IntHashTable.numItems m;
1037      let val cexp' = reduce cexp      let val cexp' = reduce cexp
1038      in  debugprint "\n";      in  debugprint "\n";
1039          if debug          if debug

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