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

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

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

revision 186, Wed Nov 11 05:24:43 1998 UTC revision 187, Wed Nov 11 07:04:24 1998 UTC
# Line 19  Line 19 
19    
20      (* inc the "true=call,false=use" count *)      (* inc the "true=call,false=use" count *)
21      val use    : FLINT.value list option -> info -> unit      val use    : FLINT.value list option -> info -> unit
22      (* dec the "true=call,false=use" count and call the function (and return true) if zero *)      (* dec the "true=call,false=use" count and return true if zero *)
23      val unuse  : (FLINT.lvar -> unit) -> bool -> FLINT.lvar -> bool      val unuse  : bool -> info -> bool
24      (* transfer the counts of var1 to var2 *)      (* transfer the counts of var1 to var2 *)
25      val transfer : FLINT.lvar * FLINT.lvar -> unit      val transfer : FLINT.lvar * FLINT.lvar -> unit
26      (* add the counts of var1 to var2 *)      (* add the counts of var1 to var2 *)
27      (*  val addto  : info * info -> unit *)      (*  val addto  : info * info -> unit *)
28      (* delete the last reference to a variable *)      (* delete the last reference to a variable *)
29      val kill   : FLINT.lvar -> unit      (*  val kill   : FLINT.lvar -> unit *)
30      (* create a new var entry (SOME arg list if fun) initialized to zero *)      (* create a new var entry (SOME arg list if fun) initialized to zero *)
31      val new    : FLINT.lvar list option -> FLINT.lvar -> info      val new    : FLINT.lvar list option -> FLINT.lvar -> info
32    
# Line 34  Line 34 
34      (* val copy   : FLINT.lvar * FLINT.lvar -> unit *)      (* val copy   : FLINT.lvar * FLINT.lvar -> unit *)
35    
36      (* fix up function to keep counts up-to-date when getting rid of code.      (* fix up function to keep counts up-to-date when getting rid of code.
37       * the arg is only called for *free* variables becoming dead.       * the arg is called for *free* variables becoming dead. *)
38       * the first function returned just unuses an exp, while the      val unuselexp : (FLINT.lvar -> unit) -> FLINT.lexp -> unit
      * second unuses a function declaration (f,args,body) *)  
     val unuselexp : (FLINT.lvar -> unit) ->  
         ((FLINT.lexp -> unit) *  
          ((FLINT.lvar * FLINT.lvar list * FLINT.lexp) -> unit))  
39      (* function to collect info about a newly created lexp *)      (* function to collect info about a newly created lexp *)
40      val uselexp : FLINT.lexp -> unit      val uselexp : FLINT.lexp -> unit
41      (* function to copy (and collect info) a lexp *)      (* function to copy (and collect info) a lexp *)
# Line 91  Line 87 
87  fun ASSERT (true,_) = ()  fun ASSERT (true,_) = ()
88    | ASSERT (FALSE,msg) = bug ("assertion "^msg^" failed")    | ASSERT (FALSE,msg) = bug ("assertion "^msg^" failed")
89    
90  exception UnexpectedTransfer  type info
91      (* we keep track of calls and escaping uses *)
92  datatype info    = {calls: int ref, uses: int ref,
93    (* for functions we keep track of calls and escaping uses *)       args: (FLINT.lvar * (FLINT.value option)) option list ref option}
   = Fun of {calls: int ref, uses: int ref,  
             args: (FLINT.lvar * (FLINT.value option)) option list ref}  
   | Var of int ref      (* for other vars, a simple use count is kept *)  
   | Transfer of FLINT.lvar      (* for vars which have been transfered *)  
94    
95  exception NotFound  exception NotFound
96    
# Line 111  Line 103 
103                          (LV.lvarName lv)^                          (LV.lvarName lv)^
104                          ". Pretending dead...\n");                          ". Pretending dead...\n");
105                     (*  raise x; *)                     (*  raise x; *)
106                     Var (ref 0))                     {uses=ref 0, calls=ref 0, args=NONE})
107    
108  fun LVarString lv =  fun LVarString lv =
109      (LV.lvarName lv)^      let val {uses=ref uses,calls=ref calls,...} = get lv
110      ((case get lv of      in (LV.lvarName lv)^
111           Var uses => "{"^(Int.toString (!uses))^"}"          "{"^(Int.toString uses)^
112         | Fun {calls,uses,...} =>          (if calls > 0 then ","^(Int.toString calls) else "")^"}"
113           concat ["{", Int.toString (!uses), ",", Int.toString (!calls), "}"]      end
        | Transfer lv => "{->"^(LVarString lv)^"}")  
          handle NotFound => "{?}")  
   
 fun get' lv = case get lv of Transfer nlv => get' nlv | i => i  
114    
115  fun new args lv =  fun new args lv =
116      let val i =      let val i = {uses=ref 0, calls=ref 0,
117              case args                   args=case args
118               of SOME args => Fun{calls=ref 0, uses=ref 0,                         of SOME args => SOME(ref(map (fn a => SOME(a, NONE)) args))
119                                   args=ref (map (fn a => SOME(a, NONE)) args)}                          | NONE => NONE}
               | NONE => Var(ref 0)  
120      in M.add m (lv, i); i      in M.add m (lv, i); i
121      end      end
122    
123  (* adds the counts of lv1 to those of lv2 *)  (* adds the counts of lv1 to those of lv2 *)
124  fun addto (info1,info2) =  fun addto ({uses=uses1,calls=calls1,...}:info,{uses=uses2,calls=calls2,...}:info) =
     case info1  
      of Var uses1 =>  
         (case info2  
           of Var uses2 => uses2 := !uses2 + !uses1  
            | Fun {uses=uses2,...} => uses2 := !uses2 + !uses1  
            | Transfer _ => raise UnexpectedTransfer)  
       | Fun {uses=uses1,calls=calls1,...} =>  
         (case info2  
           of Fun {uses=uses2,calls=calls2,...} =>  
125               (uses2 := !uses2 + !uses1; calls2 := !calls2 + !calls1)               (uses2 := !uses2 + !uses1; calls2 := !calls2 + !calls1)
            | Var uses2 => uses2 := !uses2 + !uses1  
            | Transfer _ => raise UnexpectedTransfer)  
       | Transfer _ => raise UnexpectedTransfer  
126    
127  fun transfer (lv1,lv2) =  fun transfer (lv1,lv2) =
128      (addto(get lv1, get lv2);      let val i1 = get lv1
129       (* note the transfer *)          val i2 = get lv2
130       M.add m (lv1, Transfer lv2)) handle x => raise x      in addto(i1, i2);
131            (* note the transfer by redirecting the map *)
132            M.add m (lv1, i2)
133        end
134    
135  fun inc ri = (ri := !ri + 1)  fun inc ri = (ri := !ri + 1)
136  fun dec ri = (ri := !ri - 1)  fun dec ri = (ri := !ri - 1)
# Line 166  Line 144 
144    | mergearg (SOME(fv,SOME b),a) =    | mergearg (SOME(fv,SOME b),a) =
145      if a = b orelse a = F.VAR fv then SOME(fv,SOME b) else NONE      if a = b orelse a = F.VAR fv then SOME(fv,SOME b) else NONE
146    
147  fun actuals (Var _) = bug "can't query actuals of a var" (* (LVarString lv) *)  fun actuals ({args=NONE,...}:info) = bug "can't query actuals of a var"
148    | actuals (Transfer lv) = raise UnexpectedTransfer    | actuals {args=SOME args,...} = map (fn SOME(_,v) => v | _ => NONE) (!args)
   | actuals (Fun{args,...}) = map (fn SOME(_,v) => v | _ => NONE) (!args)  
   
 fun use call (Var uses) = inc uses  
   | use call (Transfer lv) = raise UnexpectedTransfer  
   | use call (Fun {uses,calls,args,...}) =  
     case call of  
         NONE => (inc uses; args := map (fn _ => NONE) (!args))  
       | SOME vals =>  
         (inc calls; inc uses; args := ListPair.map mergearg (!args, vals))  
149    
150  fun unuse undertaker call lv =  fun use call ({uses,calls,args,...}:info) =
151      let fun check uses =      (inc uses;
152              if !uses < 0 then       case call
153                  bugval("decrementing too much", F.VAR lv)        of NONE => (case args of SOME args => args := map (fn _ => NONE) (!args)
154              else if !uses = 0 then                               | _ => ())
155                  (undertaker lv; true)        | SOME vals =>
156              else false          (inc calls;
157      in case get' lv           case args of SOME args => args := ListPair.map mergearg (!args, vals)
158          of Var uses => (dec uses; check uses)                      | _ => ()))
159           | Fun {uses,calls,...} =>  
160             (dec uses; if (call andalso !calls > 0) then dec calls else ASSERT(!uses >= !calls, "unknown sanity"); check uses)  fun unuse call ({uses,calls,...}:info) =
161           | Transfer lv => bug "transfer"      (* notice the calls could be dec'd to negative values because a
162      end handle x => raise x       * use might be turned from escaping to known between the census
163         * and the unuse.  We can't easily detect such changes, but
164  fun usenb (Fun{uses=uses,...} | Var uses) = !uses       * we can detect it happened when we try to go below zero. *)
165    | usenb (Transfer _) = (raise UnexpectedTransfer; 0)      (dec uses;
166  fun used i      = usenb i > 0       if (call andalso !calls > 0) then dec calls
167         else ASSERT(!uses >= !calls, "unknown sanity");
168  fun escaping (Fun{uses,calls,...}) = !uses > !calls       if !uses < 0 then bug "decrementing too much" (* F.VAR lv) *)
169    | escaping (Var us) = !us > 0 (* arbitrary, but hopefully "safe" *)       else !uses = 0)
170    | escaping (Transfer lv) = raise UnexpectedTransfer  
171    fun usenb ({uses=ref uses,...}:info) = uses
172  fun called (Fun{calls,...}) = !calls > 0  fun used ({uses,...}:info) = !uses > 0
173    | called (Var us) = false (* arbitrary, but consistent with escaping *)  fun escaping ({uses,calls,...}:info) = !uses > !calls
174    | called (Transfer lv) = raise UnexpectedTransfer  fun called ({calls,...}:info) = !calls > 0
175    
176  (* Ideally, we should check that usenb = 1, but we may have been a bit  (* Ideally, we should check that usenb = 1, but we may have been a bit
177   * conservative when keeping the counts uptodate *)   * conservative when keeping the counts uptodate *)
178  fun kill lv = (ASSERT(usenb(get' lv) >= 1, "usenb "^(LVarString lv)^" >= 1 ");  fun kill lv = (ASSERT(usenb(get lv) >= 1, "usenb "^(LVarString lv)^" >= 1 ");
179                 M.rmv m lv)                 M.rmv m lv)
180    
181  (* ********************************************************************** *)  (* ********************************************************************** *)
# Line 234  Line 203 
203    
204  val census = let  val census = let
205      (* val use = if inc then use else unuse *)      (* val use = if inc then use else unuse *)
206      fun call args lv = use args (get' lv)      fun call args lv = use args (get lv)
207      val use = fn F.VAR lv => use NONE (get' lv) | _ => ()      val use = fn F.VAR lv => use NONE (get lv) | _ => ()
208      fun newv lv = new NONE lv      fun newv lv = new NONE lv
209      fun newf args lv = new args lv      fun newf args lv = new args lv
210      fun id x = x      fun id x = x
# Line 338  Line 307 
307   * is indeed exactly 1 (accomplished by the "kill" calls) *)   * is indeed exactly 1 (accomplished by the "kill" calls) *)
308  fun unuselexp undertaker = let  fun unuselexp undertaker = let
309      (* val use = if inc then use else unuse *)      (* val use = if inc then use else unuse *)
310      fun uncall lv = ignore(unuse undertaker true lv)      fun uncall lv = if unuse true (get lv) then undertaker lv else ()
311      val unuse = fn F.VAR lv => ignore(unuse undertaker false lv) | _ => ()      val unuse = fn F.VAR lv => if unuse false (get lv) then undertaker lv else ()
312      fun def lv = (use NONE (get lv)) handle x => raise x                   | _ => ()
313        fun def i = (use NONE i)
314      fun id x = x      fun id x = x
315    
316      fun cpo (NONE:F.dict option,po,lty,tycs) = ()      fun cpo (NONE:F.dict option,po,lty,tycs) = ()
# Line 349  Line 319 
319      fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = unuse(F.VAR lv)      fun cdcon (s,Access.EXN(Access.LVAR lv),lty) = unuse(F.VAR lv)
320        | cdcon _ = ()        | cdcon _ = ()
321    
322      fun cfun (f,args,body) = (* census of a fundec *)      fun cfun (args,body) = (* census of a fundec *)
323          (app def args; cexp body; app kill args) handle x => raise x          (app (def o get) args; cexp body; app kill args) handle x => raise x
324    
325      and cexp lexp =      and cexp lexp =
326          (case lexp          (case lexp
327           of F.RET vs => app unuse vs           of F.RET vs => app unuse vs
328    
329            | F.LET (lvs,le1,le2) =>            | F.LET (lvs,le1,le2) =>
330              (app def lvs; cexp le2; cexp le1; app kill lvs)              (app (def o get) lvs; cexp le2; cexp le1; app kill lvs)
331    
332            | F.FIX (fs,le) =>            | F.FIX (fs,le) =>
333              let val usedfs = (List.filter ((used o get o #2) handle x => raise x) fs)              let val fs = map (fn (_,f,args,body) => (get f, f, args, body)) fs
334              in app (def o #2) fs;                  val usedfs = (List.filter (used o #1) fs)
335                in app (def o #1) fs;
336                  cexp le;                  cexp le;
337                  app (fn (_,lv,args,le) => cfun(lv, map #1 args, le)) usedfs;                  app (fn (_,_,args,le) => cfun(map #1 args, le)) usedfs;
338                  app (kill o #2) fs                  app (kill o #2) fs
339              end              end
340    
# Line 371  Line 342 
342              (uncall f; app unuse vs)              (uncall f; app unuse vs)
343    
344            | F.TFN ((tf,args,body),le) =>            | F.TFN ((tf,args,body),le) =>
345              (if used(get tf) then cexp body else ();               let val tfi = get tf
346               def tf; cexp le; kill tf)               in if used tfi then cexp body else ();
347                     def tfi; cexp le; kill tf
348                 end
349    
350            | F.TAPP (F.VAR tf,tycs) => uncall tf            | F.TAPP (F.VAR tf,tycs) => uncall tf
351    
# Line 381  Line 354 
354               (* here we don't absolutely have to keep track of vars bound within               (* here we don't absolutely have to keep track of vars bound within
355                * each arm since these vars can't be eliminated anyway *)                * each arm since these vars can't be eliminated anyway *)
356               app (fn (F.DATAcon(dc,_,lv),le) =>               app (fn (F.DATAcon(dc,_,lv),le) =>
357                    (cdcon dc; def lv; cexp le; kill lv)                    (cdcon dc; def(get lv); cexp le; kill lv)
358                     | (_,le) => cexp le)                     | (_,le) => cexp le)
359                   arms)                   arms)
360    
361            | F.CON (dc,_,v,lv,le) =>            | F.CON (dc,_,v,lv,le) =>
362              (cdcon dc; if used(get lv) then unuse v else ();              let val lvi = get lv
363               def lv; cexp le; kill lv)              in cdcon dc; if used lvi then unuse v else ();
364                    def lvi; cexp le; kill lv
365                end
366    
367            | F.RECORD (_,vs,lv,le) =>            | F.RECORD (_,vs,lv,le) =>
368              (if used(get lv) then app unuse vs else ();              let val lvi = get lv
369               def lv; cexp le; kill lv)              in if used lvi then app unuse vs else ();
370                    def lvi; cexp le; kill lv
371                end
372    
373            | F.SELECT (v,_,lv,le) =>            | F.SELECT (v,_,lv,le) =>
374              (if used(get lv) then unuse v else ();              let val lvi = get lv
375               def lv; cexp le; kill lv)              in if used lvi then unuse v else ();
376                    def lvi; cexp le; kill lv
377                end
378    
379            | F.RAISE (v,_) => unuse v            | F.RAISE (v,_) => unuse v
380            | F.HANDLE (le,v) => (unuse v; cexp le)            | F.HANDLE (le,v) => (unuse v; cexp le)
# Line 404  Line 383 
383              (app unuse vs; cpo po; cexp le1; cexp le2)              (app unuse vs; cpo po; cexp le1; cexp le2)
384    
385            | F.PRIMOP (po,vs,lv,le) =>            | F.PRIMOP (po,vs,lv,le) =>
386              (if impurePO po orelse used(get lv) then              let val lvi = get lv
387                   (cpo po; app unuse vs)              in if impurePO po orelse used lvi
388                   then (cpo po; app unuse vs)
389               else ();               else ();
390               def lv; cexp le; kill lv)                 def lvi; cexp le; kill lv
391                end
392    
393            | le => buglexp("unexpected lexp", le)) handle x => raise x            | le => buglexp("unexpected lexp", le)) handle x => raise x
394  in  in
395      (cexp, cfun)      cexp
396  end  end
397    
398  val uselexp = census All  val uselexp = census All

Legend:
Removed from v.186  
changed lines
  Added in v.187

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