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

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

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

revision 488, Tue Nov 23 11:07:04 1999 UTC revision 489, Tue Nov 23 12:55:00 1999 UTC
# Line 80  Line 80 
80      fun lookup (F.VAR lv) = M.find(mf, lv)      fun lookup (F.VAR lv) = M.find(mf, lv)
81        | lookup _ = NONE        | lookup _ = NONE
82    
83        fun S_rmv(x, s) = S.delete(s, x) handle NotFound => s
84    
85      fun addv (s,F.VAR lv) = S.add(s, lv)      fun addv (s,F.VAR lv) = S.add(s, lv)
86        | addv (s,_) = s        | addv (s,_) = s
87      fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs      fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs
88      fun rmvs (s,lvs) = foldl (fn (l,s) => S.delete(s, l)) s lvs      fun rmvs (s,lvs) = foldl (fn (l,s) => S_rmv(l, s)) s lvs
89    
90      (* Looks for free vars in the primop descriptor.      (* Looks for free vars in the primop descriptor.
91       * This is normally unnecessary since these are special vars anyway *)       * This is normally unnecessary since these are special vars anyway *)
# Line 331  Line 333 
333       | F.TFN ((tfk,f,args,body),le) =>       | F.TFN ((tfk,f,args,body),le) =>
334         let val (se,fve,le) = loop le         let val (se,fve,le) = loop le
335             val (sb,fvb,body) = loop body             val (sb,fvb,body) = loop body
336         in (sb + se, S.union(S.delete(fve, f), fvb),         in (sb + se, S.union(S_rmv(f, fve), fvb),
337             F.TFN((tfk, f, args, body), le))             F.TFN((tfk, f, args, body), le))
338         end         end
339       | F.TAPP (F.VAR f,args) =>       | F.TAPP (F.VAR f,args) =>
# Line 345  Line 347 
347         let fun farm (dcon as F.DATAcon(dc,_,lv),le) =         let fun farm (dcon as F.DATAcon(dc,_,lv),le) =
348                 (* the binding might end up costly, but we count it as 1 *)                 (* the binding might end up costly, but we count it as 1 *)
349                 let val (s,fv,le) = loop le                 let val (s,fv,le) = loop le
350                 in (1+s, fdcon(S.delete(fv, lv),dc), (dcon, le))                 in (1+s, fdcon(S_rmv(lv, fv),dc), (dcon, le))
351                 end                 end
352               | farm (dc,le) =               | farm (dc,le) =
353                 let val (s,fv,le) = loop le in (s, fv, (dc, le)) end                 let val (s,fv,le) = loop le in (s, fv, (dc, le)) end
# Line 366  Line 368 
368         end         end
369       | F.CON (dc,tycs,v,lv,le) =>       | F.CON (dc,tycs,v,lv,le) =>
370         let val (s,fv,le) = loop le         let val (s,fv,le) = loop le
371         in (2+s, fdcon(addv(S.delete(fv, lv), v),dc), F.CON(dc, tycs, v, lv, le))         in (2+s, fdcon(addv(S_rmv(lv, fv), v),dc), F.CON(dc, tycs, v, lv, le))
372         end         end
373       | F.RECORD (rk,vs,lv,le) =>       | F.RECORD (rk,vs,lv,le) =>
374         let val (s,fv,le) = loop le         let val (s,fv,le) = loop le
375         in ((length vs)+s, addvs(S.delete(fv, lv), vs), F.RECORD(rk, vs, lv, le))         in ((length vs)+s, addvs(S_rmv(lv, fv), vs), F.RECORD(rk, vs, lv, le))
376         end         end
377       | F.SELECT (v,i,lv,le) =>       | F.SELECT (v,i,lv,le) =>
378         let val (s,fv,le) = loop le         let val (s,fv,le) = loop le
# Line 378  Line 380 
380              of SOME(Arg(d,ac as ref(sp,ti))) =>              of SOME(Arg(d,ac as ref(sp,ti))) =>
381                 ac := (sp + 1, OU.pow2(depth - d) + ti)                 ac := (sp + 1, OU.pow2(depth - d) + ti)
382               | _ => ());               | _ => ());
383             (1+s, addv(S.delete(fv, lv), v), F.SELECT(v,i,lv,le))             (1+s, addv(S_rmv(lv, fv), v), F.SELECT(v,i,lv,le))
384         end         end
385       | F.RAISE (F.VAR v,ltys) =>       | F.RAISE (F.VAR v,ltys) =>
386         (* artificially high size estimate to discourage inlining *)         (* artificially high size estimate to discourage inlining *)
# Line 395  Line 397 
397         end         end
398       | F.PRIMOP (po,vs,lv,le) =>       | F.PRIMOP (po,vs,lv,le) =>
399         let val (s,fv,le) = loop le         let val (s,fv,le) = loop le
400         in (1+s, fpo(addvs(S.delete(fv, lv), vs),po), F.PRIMOP(po,vs,lv,le))         in (1+s, fpo(addvs(S_rmv(lv, fv), vs),po), F.PRIMOP(po,vs,lv,le))
401         end         end
402    
403       | F.APP _ => bug "bogus F.APP"       | F.APP _ => bug "bogus F.APP"

Legend:
Removed from v.488  
changed lines
  Added in v.489

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