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 197, Sun Nov 22 01:25:23 1998 UTC revision 199, Wed Nov 25 18:30:38 1998 UTC
# Line 94  Line 94 
94  fun bug msg = ErrorMsg.impossible ("Collect: "^msg)  fun bug msg = ErrorMsg.impossible ("Collect: "^msg)
95  fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)  fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)
96  fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)  fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
 fun ASSERT (true,_) = ()  
   | ASSERT (FALSE,msg) = bug ("assertion "^msg^" failed")  
97    
98  datatype info  datatype info
99    (* we keep track of calls and escaping uses *)    (* we keep track of calls and escaping uses *)
# Line 112  Line 110 
110    
111  (* map related helper functions *)  (* map related helper functions *)
112  fun get lv = (M.map m lv)  fun get lv = (M.map m lv)
113                    handle x as NotFound =>                    (* handle x as NotFound =>
114                    (say ("Collect: ERROR: get unknown var "^                    (say ("Collect: ERROR: get unknown var "^
115                          (LV.lvarName lv)^                          (LV.lvarName lv)^
116                          ". Pretending dead...\n");                          ". Pretending dead...\n");
117                     (*  raise x; *)                     (*  raise x; *)
118                     new NONE lv)                     new NONE lv) *)
119    
120  fun LVarString lv =  fun LVarString lv =
121      let val Info{uses=ref uses,calls=ref calls,...} = get lv      let val Info{uses=ref uses,calls=ref calls,...} = get lv
# Line 164  Line 162 
162       * we can detect it happened when we try to go below zero. *)       * we can detect it happened when we try to go below zero. *)
163      (dec uses;      (dec uses;
164       if (call (*  andalso !calls > 0 *)) then dec calls       if (call (*  andalso !calls > 0 *)) then dec calls
165       else ASSERT(!uses >= !calls, "unknown sanity");       else ();
166       if !uses < 0 then bug "decrementing too much" (* F.VAR lv) *)       if !uses < 0 then bug "decrementing too much" (* F.VAR lv) *)
167       else !uses = 0)       else !uses = 0)
168    
# Line 180  Line 178 
178    
179  (* 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
180   * conservative when keeping the counts uptodate *)   * conservative when keeping the counts uptodate *)
181  fun kill lv = (ASSERT(usenb(get lv) >= 1, "usenb "^(LVarString lv)^" >= 1 ");  fun kill lv = (M.rmv m lv)
                M.rmv m lv)  
182    
183  (* ********************************************************************** *)  (* ********************************************************************** *)
184  (* ********************************************************************** *)  (* ********************************************************************** *)
# Line 227  Line 224 
224       * `uvs' is an optional list of booleans representing which of       * `uvs' is an optional list of booleans representing which of
225       * the return values are actually used *)       * the return values are actually used *)
226      fun cexp lexp =      fun cexp lexp =
227          (case lexp          case lexp
228           of F.RET vs => app use vs           of F.RET vs => app use vs
229    
230            | F.LET (lvs,le1,le2) =>            | F.LET (lvs,le1,le2) =>
# Line 300  Line 297 
297                  if impurePO po orelse used lvi then (cpo po; app use vs) else ()                  if impurePO po orelse used lvi then (cpo po; app use vs) else ()
298              end              end
299    
300            | le => buglexp("unexpected lexp", le)) handle x => raise x            | le => buglexp("unexpected lexp", le)
301  in  in
302      cexp      cexp
303  end  end
# Line 328  Line 325 
325        | cdcon _ = ()        | cdcon _ = ()
326    
327      fun cfun (args,body) = (* census of a fundec *)      fun cfun (args,body) = (* census of a fundec *)
328          (app (def o get) args; cexp body; app kill args) handle x => raise x          (app (def o get) args; cexp body; app kill args)
329    
330      and cexp lexp =      and cexp lexp =
331          (case lexp          case lexp
332           of F.RET vs => app unuse vs           of F.RET vs => app unuse vs
333    
334            | F.LET (lvs,le1,le2) =>            | F.LET (lvs,le1,le2) =>
# Line 398  Line 395 
395                 def lvi; cexp le; kill lv                 def lvi; cexp le; kill lv
396              end              end
397    
398            | le => buglexp("unexpected lexp", le)) handle x => raise x            | le => buglexp("unexpected lexp", le)
399  in  in
400      cexp      cexp
401  end  end
# Line 412  Line 409 
409  fun collect (fdec as (_,f,_,_)) =  fun collect (fdec as (_,f,_,_)) =
410      ((*  say "Entering Collect...\n"; *)      ((*  say "Entering Collect...\n"; *)
411       M.clear m;                         (* start from a fresh state *)       M.clear m;                         (* start from a fresh state *)
412       PP.LVarString := LVarString;       (* PP.LVarString := LVarString; *)
413       uselexp (F.FIX([fdec], F.RET[F.VAR f]));       uselexp (F.FIX([fdec], F.RET[F.VAR f]));
414       (*  say "...Collect Done.\n"; *)       (*  say "...Collect Done.\n"; *)
415       fdec)       fdec)

Legend:
Removed from v.197  
changed lines
  Added in v.199

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