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 212, Fri Jan 15 16:19:21 1999 UTC revision 213, Fri Jan 15 21:18:35 1999 UTC
# Line 51  Line 51 
51  end  end
52  structure SCC = SCCUtilFun (structure Node = SccNode)  structure SCC = SCCUtilFun (structure Node = SccNode)
53    
54    datatype info = Fun of int ref
55                  | Arg of int * (int * int) ref
56    
57  (* fexp: int ref intmapf -> lexp) -> (int * intset * lexp)  (* fexp: int ref intmapf -> lexp) -> (int * intset * lexp)
58   * The intmap contains refs to counters.  The meaning of the counters   * The intmap contains refs to counters.  The meaning of the counters
59   * is slightly overloaded:   * is slightly overloaded:
# Line 68  Line 71 
71   *   which are assumed to be the freevars of the continuation of lexp)   *   which are assumed to be the freevars of the continuation of lexp)
72   * - a new lexp with FIXes rewritten.   * - a new lexp with FIXes rewritten.
73   *)   *)
74  fun fexp mf lexp = let  fun fexp mf depth lexp = let
75    
76      val loop = fexp mf      val loop = fexp mf depth
77    
78      fun lookup (F.VAR lv) = M.lookup mf lv      fun lookup (F.VAR lv) = M.lookup mf lv
79        | lookup _ = raise M.IntmapF        | lookup _ = raise M.IntmapF
# Line 188  Line 191 
191    
192             (* create call-counters for each fun and add them to fm *)             (* create call-counters for each fun and add them to fm *)
193             val (fs,mf) = foldl (fn ((fk,f,args,body),(fs,mf)) =>             val (fs,mf) = foldl (fn ((fk,f,args,body),(fs,mf)) =>
194                                  let val c = ref ~1                                  let val c = ref 0
195                                  in ((fk,f,args,body,c)::fs, M.add(mf, f, ref 0))                                  in ((fk, f, args, body, c)::fs,
196                                        M.add(mf, f, Fun c))
197                                  end)                                  end)
198                                 ([],mf)                                 ([],mf)
199                                 fdecs                                 fdecs
# Line 203  Line 207 
207                     let val ((fk,f,fargs,fbody),(fk',f',fargs',fbody')) =                     let val ((fk,f,fargs,fbody),(fk',f',fargs',fbody')) =
208                             uncurry(args,body)                             uncurry(args,body)
209                         (* add the wrapper function *)                         (* add the wrapper function *)
210                         val cs = map (fn _ => ref 0) fargs                         val cs = map (fn _ => ref(0,0)) fargs
211                         val nm = M.add(m, f, ([f'], 1, fk, fargs, fbody, cf, cs))                         val nm = M.add(m, f, ([f'], 1, fk, fargs, fbody, cf, cs))
212                     (* now, retry ffun with the uncurried function *)                     (* now, retry ffun with the uncurried function *)
213                     in ffun((fk', f', fargs', fbody', ref 1),                     in ffun((fk', f', fargs', fbody', ref 1),
214                             (s+1, fv, S.add(f', funs), nm))                             (s+1, fv, S.add(f', funs), nm))
215                     end                     end
216                   | _ => (* non-curried function *)                   | _ => (* non-curried function *)
217                     let val (mf,cs) = foldr (fn ((v,t),(m,cs)) =>                     let val newdepth =
218                                              let val c = ref 0                             case isrec
219                                              in (M.add(m, v, c), c::cs) end)                              of SOME(_,(F.LK_TAIL | F.LK_LOOP)) => depth + 1
220                                 | _ => depth
221                           val (mf,cs) = foldr (fn ((v,t),(m,cs)) =>
222                                                let val c = ref(0, 0)
223                                                in (M.add(m, v, Arg(newdepth, c)),
224                                                    c::cs) end)
225                                             (mf,[]) args                                             (mf,[]) args
226                         val (fs,ffv,body) = fexp mf body                         val (fs,ffv,body) = fexp mf newdepth body
227                         val ffv = rmvs(ffv, map #1 args) (* fun's freevars *)                         val ffv = rmvs(ffv, map #1 args) (* fun's freevars *)
228                         val ifv = S.inter(ffv, funs) (* set of rec funs ref'ed *)                         val ifv = S.inter(ffv, funs) (* set of rec funs ref'ed *)
                        val fs = fs div (case isrec of SOME(_,F.LK_TAIL) => 3  
                                                     | SOME(_,F.LK_LOOP) => 1  
                                                     | _ => 1)  
229                     in                     in
230                         (fs + s, S.union(ffv, fv), funs,                         (fs + s, S.union(ffv, fv), funs,
231                          M.add(m, f, (S.members ifv, fs, fk, args, body, cf, cs)))                          M.add(m, f, (S.members ifv, fs, fk, args, body, cf, cs)))
# Line 230  Line 236 
236              * includes freevars of the continuation, but the uniqueness              * includes freevars of the continuation, but the uniqueness
237              * of varnames ensures that S.inter(fv, funs) gives the correct              * of varnames ensures that S.inter(fv, funs) gives the correct
238              * result nonetheless. *)              * result nonetheless. *)
239             val (s,fv,le) = fexp mf le             val (s,fv,le) = fexp mf depth le
240             val lename = LambdaVar.mkLvar()             val lename = LambdaVar.mkLvar()
241             val m = M.singleton(lename, (S.members(S.inter(fv, funs)), 0,             val m = M.singleton(lename, (S.members(S.inter(fv, funs)), 0,
242                                          {inline=F.IH_SAFE, isrec=NONE,                                          {inline=F.IH_SAFE, isrec=NONE,
# Line 249  Line 255 
255                     val ilthreshold = !CTRL.inlineThreshold + (length args)                     val ilthreshold = !CTRL.inlineThreshold + (length args)
256                     val ilh =                     val ilh =
257                         if inline = F.IH_ALWAYS then inline                         if inline = F.IH_ALWAYS then inline
258                         else if s < ilthreshold then F.IH_ALWAYS                         (* else if s < ilthreshold then F.IH_ALWAYS *)
259                         else let val cs = map (op!) cs                         else let val cs = map (fn ref(sp,ti) => sp + ti div 2) cs
260                                  val s' = foldl (op+) 0 cs                                  val s' = foldl (op+) 0 cs
261                         in if s < 2*s' + ilthreshold                         in if s < 2*s' + ilthreshold
262                            then ((* say((Collect.LVarString f)^" = F.IH_MAYBE "^(Int.toString (s-ilthreshold))^(foldl (fn (i,s) => s^" "^(Int.toString i)) "" cs)^"\n"); *)                            then ((* say((Collect.LVarString f)^" = F.IH_MAYBE "^
263                                        (Int.toString (s-ilthreshold))^
264                                        (foldl (fn (i,s) => s^" "^
265                                                (Int.toString i))
266                                         "" cs)^"\n"); *)
267                                  F.IH_MAYBE (s-ilthreshold, cs))                                  F.IH_MAYBE (s-ilthreshold, cs))
268                            else inline                            else inline
269                         end                         end
# Line 290  Line 300 
300         (* For known functions, increase the counter and         (* For known functions, increase the counter and
301          * make the call a bit cheaper. *)          * make the call a bit cheaper. *)
302         let val scall =         let val scall =
303                 (let val cf as ref c = M.lookup mf f                 (case M.lookup mf f
304                 in if c < 0                   of Fun(fc as ref c) => (fc := c + 1; 1)
305                    then (cf := c - 1; 1)                    | Arg(d, ac as ref (sp,ti)) =>
306                    else (cf := c + 5; 5)                      (ac := (4 + sp, OU.pow2(depth - d) * 30 + ti); 5))
307                 end) handle M.IntmapF => 5                     handle M.IntmapF => 5
308         in         in
309             (scall + (length args), addvs(S.singleton f, args), lexp)             (scall + (length args), addvs(S.singleton f, args), lexp)
310         end         end
# Line 318  Line 328 
328                 end                 end
329               | farm (dc,le) =               | farm (dc,le) =
330                 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
331               val narms = length arms
332             val (s,smax,fv,arms) =             val (s,smax,fv,arms) =
333                 foldl (fn ((s1,fv1,arm),(s2,smax,fv2,arms)) =>                 foldl (fn ((s1,fv1,arm),(s2,smax,fv2,arms)) =>
334                        (s1+s2, Int.max(s1,smax), S.union(fv1, fv2), arm::arms))                        (s1+s2, Int.max(s1,smax), S.union(fv1, fv2), arm::arms))
335                       (0, 0, S.empty, []) (map farm arms)                       (narms, 0, S.empty, []) (map farm arms)
336         in  let val cf = lookup v in cf := !cf+s-smax end handle M.IntmapF=>();         in (case lookup v
337                of Arg(d,ac as ref(sp,ti)) =>
338                   ac := (sp + s - smax + narms, OU.pow2(depth - d) * 2 + ti)
339                 | _ => ()) handle M.IntmapF => ();
340             case def             case def
341             of NONE => (s, fv, F.SWITCH(v, ac, arms, NONE))             of NONE => (s, fv, F.SWITCH(v, ac, arms, NONE))
342              | SOME le => let val (sd,fvd,le) = loop le              | SOME le => let val (sd,fvd,le) = loop le
# Line 339  Line 353 
353         end         end
354       | F.SELECT (v,i,lv,le) =>       | F.SELECT (v,i,lv,le) =>
355         let val (s,fv,le) = loop le         let val (s,fv,le) = loop le
356         in let val cf = lookup v in cf := !cf + 1 end handle M.IntmapF=>();         in (case lookup v
357                of Arg(d,ac as ref(sp,ti)) =>
358                   ac := (sp + 1, OU.pow2(depth - d) + ti)
359                 | _ => ()) handle M.IntmapF=>();
360             (1+s, addv(S.rmv(lv, fv), v), F.SELECT(v,i,lv,le))             (1+s, addv(S.rmv(lv, fv), v), F.SELECT(v,i,lv,le))
361         end         end
362       | F.RAISE (F.VAR v,ltys) => (3, S.singleton v, lexp)       | F.RAISE (F.VAR v,ltys) => (3, S.singleton v, lexp)
# Line 364  Line 381 
381  end  end
382    
383  fun fixfix ((fk,f,args,body):F.prog) =  fun fixfix ((fk,f,args,body):F.prog) =
384      let val (s,fv,nbody) = fexp M.empty body      let val (s,fv,nbody) = fexp M.empty 0 body
385          val fv = S.diff(fv, S.make(map #1 args))          val fv = S.diff(fv, S.make(map #1 args))
386      in      in
387          (*  PPFlint.printLexp(F.RET(map F.VAR (S.members fv))); *)          (*  PPFlint.printLexp(F.RET(map F.VAR (S.members fv))); *)

Legend:
Removed from v.212  
changed lines
  Added in v.213

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