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

Diff of /sml/trunk/src/compiler/FLINT/opt/lift.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 54  Line 54 
54  type abstract = bool  type abstract = bool
55    
56  type var = (lty * lvar list * depth * tdepth * abstract * num)  type var = (lty * lvar list * depth * tdepth * abstract * num)
57  type venv = var Intmap.intmap  type venv = var IntHashTable.hash_table
58    
59  type freevar = (lvar * lty)  type freevar = (lvar * lty)
60  type fenv = (freevar Intmap.intmap) list  type fenv = (freevar IntHashTable.hash_table) list
61    
62    
63    
# Line 75  Line 75 
75  fun adjust(t, ntd, otd) = LE.lt_adj(t, otd, ntd)  fun adjust(t, ntd, otd) = LE.lt_adj(t, otd, ntd)
76    
77  fun findEnv(v, Ienv(venv,fenvs)) =  fun findEnv(v, Ienv(venv,fenvs)) =
78      (Intmap.map venv v) handle _ => (print (Int.toString v); bug "findEnv: var not found" )      (IntHashTable.lookup venv v)
79        handle _ => (print (Int.toString v); bug "findEnv: var not found" )
80    
81  fun getVar (v, Ienv(venv,fenv :: fenvs), t, td, td') =  fun getVar (v, Ienv(venv,fenv :: fenvs), t, td, td') =
82      ((let      ((let
83          val (v', nt') = (Intmap.map fenv v)          val (v', nt') = (IntHashTable.lookup fenv v)
84      in  (v', nt', nil)      in  (v', nt', nil)
85      end) handle _ => let val v' = mkv()      end) handle _ => let val v' = mkv()
86                           val nt' = adjust(t, td, td')                           val nt' = adjust(t, td, td')
87                           val _ = Intmap.add fenv (v, (v', nt'))                           val _ = IntHashTable.insert fenv (v, (v', nt'))
88    
89                       in  (v', nt', [v])                       in  (v', nt', [v])
90                       end )                       end )
# Line 106  Line 107 
107    
108    
109  fun pushFenv (Ienv(venv,fenvs)) =  fun pushFenv (Ienv(venv,fenvs)) =
110      let val nt = Intmap.new(32,FTABLE)      let val nt = IntHashTable.mkTable(32,FTABLE)
111      in  Ienv(venv, nt::fenvs)      in  Ienv(venv, nt::fenvs)
112      end      end
113    
# Line 115  Line 116 
116    
117  fun addEnv (Ienv(venv,fenvs), vs, ts, fvs, td, d, abs) =  fun addEnv (Ienv(venv,fenvs), vs, ts, fvs, td, d, abs) =
118      let      let
119          fun f (v, t) = Intmap.add venv (v, (t, fvs, td, d, abs, 0))          fun f (v, t) = IntHashTable.insert venv (v, (t, fvs, td, d, abs, 0))
120          fun zip([], [], acc) = acc          fun zip([], [], acc) = acc
121            | zip (a::r, a'::r', acc) = zip (r, r', (a, a')::acc)            | zip (a::r, a'::r', acc) = zip (r, r', (a, a')::acc)
122            | zip _ = raise LiftCompileError            | zip _ = raise LiftCompileError
# Line 123  Line 124 
124          map f (zip (vs, ts, nil))          map f (zip (vs, ts, nil))
125      end      end
126    
127  fun rmEnv(Ienv(venv,fenvs), v) = Intmap.rmv venv v  fun rmEnv(Ienv(venv,fenvs), v) =
128        ignore (IntHashTable.remove venv v) handle _ => ()
129    
130    
131  fun getFreeVar(fvs, Ienv(venv, fenv::fenvs)) =  fun getFreeVar(fvs, Ienv(venv, fenv::fenvs)) =
132      let      let
133          fun f(v) = (Intmap.map fenv v) handle _ => bug "freevar not found"          fun f(v) = (IntHashTable.lookup fenv v)
134                handle _ => bug "freevar not found"
135      in      in
136          map f fvs          map f fvs
137      end      end
# Line 187  Line 190 
190     and td < td' then change var  *)     and td < td' then change var  *)
191    
192  fun initInfoEnv () =  fun initInfoEnv () =
193      let val venv : venv = Intmap.new(32, VENV)      let val venv : venv = IntHashTable.mkTable(32, VENV)
194          val fenv = Intmap.new(32, FENV)          val fenv = IntHashTable.mkTable(32, FENV)
195      in      in
196          Ienv (venv, [fenv])          Ienv (venv, [fenv])
197      end      end
# Line 350  Line 353 
353                         VAR v'' =>                         VAR v'' =>
354                                 let                                 let
355                                     val (t', fvs', len2, vd, _, _) =                                     val (t', fvs', len2, vd, _, _) =
356                                         (Intmap.map venv v'') handle _ =>                                         (IntHashTable.lookup venv v'')
357                                           handle _ =>
358                                            bug "Tapp var not found"                                            bug "Tapp var not found"
359                                 in                                 in
360                                     if ((len1 = len2) orelse (vd = 0))then                                     if ((len1 = len2) orelse (vd = 0))then

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