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

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

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

revision 202, Sun Dec 13 02:29:45 1998 UTC revision 733, Fri Nov 17 05:13:45 2000 UTC
# Line 14  Line 14 
14        structure LT = LtyExtern        structure LT = LtyExtern
15        structure FU = FlintUtil        structure FU = FlintUtil
16        structure PO = PrimOp        structure PO = PrimOp
17          structure M  = IntHashTable
18        open FLINT        open FLINT
19  in  in
20    
21  fun bug s = ErrorMsg.impossible ("LContract: "^s)  fun bug s = ErrorMsg.impossible ("LContract: "^s)
22  val say = Control.Print.say  val say = Control_Print.say
23  val ident = fn x => x  val ident = fn x => x
24  fun all p (a::r) = p a andalso all p r | all p nil = true  fun all p (a::r) = p a andalso all p r | all p nil = true
25    
# Line 44  Line 45 
45    
46  exception LContPass1  exception LContPass1
47  fun pass1 fdec =  fun pass1 fdec =
48    let val zz : (DI.depth option) Intmap.intmap = Intmap.new(32, LContPass1)    let val zz : (DI.depth option) M.hash_table = M.mkTable(32, LContPass1)
49        val add = Intmap.add zz        val add = M.insert zz
50        val get = Intmap.map zz        val get = M.lookup zz
51        val rmv = Intmap.rmv zz        fun rmv i = ignore (M.remove zz i) handle _ => ()
52        fun enter(x, d) = add(x, SOME d)        fun enter(x, d) = add(x, SOME d)
53        fun kill x = ((get x; rmv x) handle _ => ())        fun kill x = ((get x; rmv x) handle _ => ())
54        fun mark nd x =        fun mark nd x =
# Line 71  Line 72 
72          let fun psv (VAR x) = kill x          let fun psv (VAR x) = kill x
73                | psv _ = ()                | psv _ = ()
74    
75              and pst (v, vks, e) = lple (DI.next d) e              and pst (tfk, v, vks, e) = lple (DI.next d) e
76    
77              and pse (RET vs) = app psv vs              and pse (RET vs) = app psv vs
78                | pse (LET(vs, e1, e2)) = (pse e1; pse e2)                | pse (LET(vs, e1, e2)) = (pse e1; pse e2)
# Line 94  Line 95 
95           in pse e           in pse e
96          end          end
97    
98     in lpfd DI.top fdec; (cand, fn () => Intmap.clear zz)     in lpfd DI.top fdec; (cand, fn () => M.clear zz)
99    end (* pass1 *)    end (* pass1 *)
100    
101  (************************************************************************  (************************************************************************
# Line 115  Line 116 
116   if init then (fn _ => false, fn () => ()) else pass1 fdec   if init then (fn _ => false, fn () => ()) else pass1 fdec
117    
118  exception LContract  exception LContract
119  val m : (int ref * info) Intmap.intmap = Intmap.new(32, LContract)  val m : (int ref * info) M.hash_table = M.mkTable(32, LContract)
120    
121  val enter = Intmap.add m  val enter = M.insert m
122  val get = Intmap.map m  val get = M.lookup m
123  val kill = Intmap.rmv m  fun kill i = ignore (M.remove m i) handle _ => ()
124    
125  fun chkIn (v, info) = enter(v, (ref 0, info))  fun chkIn (v, info) = enter(v, (ref 0, info))
126    
# Line 319  Line 320 
320                       end                       end
321                   | _ => (APP(lpsv u, map lpsv us), false))                   | _ => (APP(lpsv u, map lpsv us), false))
322    
323            | TFN(tfdec as (v, tvks, xe), e) =>            | TFN(tfdec as (tfk, v, tvks, xe), e) =>
324                lplet ((fn z => TFN((v, tvks,                lplet ((fn z => TFN((tfk, v, tvks,
325                                #1(loop xe)), z)),                                #1(loop xe)), z)),
326                       true, v, StdExp, e)                       true, v, StdExp, e)
327            | TAPP(u, ts) => (TAPP(lpsv u, ts), true)            | TAPP(u, ts) => (TAPP(lpsv u, ts), true)
# Line 380  Line 381 
381  val d = DI.top  val d = DI.top
382  val (fk, f, vts, e) = fdec  val (fk, f, vts, e) = fdec
383  in (fk, f, vts, #1 (loop e))  in (fk, f, vts, #1 (loop e))
384     before (Intmap.clear m; cleanUp())     before (M.clear m; cleanUp())
385  end (* function lcontract *)  end (* function lcontract *)
386    
387  (** run the lambda contraction twice *)  (** run the lambda contraction twice *)
# Line 388  Line 389 
389    
390  end (* toplevel local *)  end (* toplevel local *)
391  end (* structure LContract *)  end (* structure LContract *)
   
   
 (*  
  * $Log$  
  *)  

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

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