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

Diff of /sml/trunk/src/compiler/FLINT/opt/fcontract.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 265  Line 265 
265           of F.VAR lv => lv           of F.VAR lv => lv
266            | v => bugval ("unexpected val", v)            | v => bugval ("unexpected val", v)
267    
     fun unuseval f (F.VAR lv) = ignore((C.unuse f false lv) handle x => raise x)  
       | unuseval f _ = ()  
   
268      (* called when a variable becomes dead.      (* called when a variable becomes dead.
269       * it simply adjusts the use-counts *)       * it simply adjusts the use-counts *)
270      fun undertake m lv =      fun undertake m lv =
# Line 276  Line 273 
273              of Var {1=nlv,...}   => ()              of Var {1=nlv,...}   => ()
274               | Val v             => ()               | Val v             => ()
275               | Fun (lv,le,args,_,_) =>               | Fun (lv,le,args,_,_) =>
276                 (#2 (C.unuselexp undertake)) (lv, map #1 args, le)                 C.unuselexp undertake
277               | TFun{1=lv,2=le,...} => (#2 (C.unuselexp undertake)) (lv, [], le)                             (F.LET(map #1 args,
278               | (Select {2=v,...} | Con {2=v,...}) => unuseval undertake v                                    F.RET (map (fn _ => F.INT 0) args),
279               | Record {2=vs,...} => app (unuseval undertake) vs                                    le))
280                 | TFun{1=lv,2=le,...} =>
281                   C.unuselexp undertake le
282                 | (Select {2=v,...} | Con {2=v,...}) => unuseval m v
283                 | Record {2=vs,...} => app (unuseval m) vs
284               (* decon's are implicit so we can't get rid of them *)               (* decon's are implicit so we can't get rid of them *)
285               | Decon _ => ()               | Decon _ => ()
286          end          end
# Line 288  Line 289 
289                       | x =>                       | x =>
290                         (say("while undertaking "^(C.LVarString lv)^"\n"); raise x)                         (say("while undertaking "^(C.LVarString lv)^"\n"); raise x)
291    
292        and unuseval m (F.VAR lv) =
293            if (C.unuse false (C.get lv)) then undertake m lv else ()
294          | unuseval f _ = ()
295        fun unusecall m lv =
296            if (C.unuse true (C.get lv)) then undertake m lv else ()
297    
298    
299      fun addbind (m,lv,sv) = M.add(m, lv, sv)      fun addbind (m,lv,sv) = M.add(m, lv, sv)
300    
301      (* substitute a value sv for a variable lv and unuse value v. *)      (* substitute a value sv for a variable lv and unuse value v. *)
302      fun substitute (m, lv1, sv, v) =      fun substitute (m, lv1, sv, v) =
303          (case sval2val sv of F.VAR lv2 => C.transfer(lv1,lv2) | v2 => ();          (case sval2val sv of F.VAR lv2 => C.transfer(lv1,lv2) | v2 => ();
304           unuseval (undertake m) v;           unuseval m v;
305           addbind(m, lv1, sv)) handle x =>           addbind(m, lv1, sv)) handle x =>
306               (say ("while substituting "^               (say ("while substituting "^
307                     (C.LVarString lv1)^                     (C.LVarString lv1)^
# Line 336  Line 344 
344                    * looks inoffensive enough, but still requires some care:                    * looks inoffensive enough, but still requires some care:
345                    * see comments at the begining of this file and in cfun *)                    * see comments at the begining of this file and in cfun *)
346                   (inlineWitness := true;                   (inlineWitness := true;
347                    C.unuse (fn _ => ()) true g;                    ignore(C.unuse true (C.get g));
348                    ASSERT(not (used g), "killed");                    ASSERT(not (used g), "killed");
349                    (SOME(F.LET(map #1 args, F.RET vs, body), od), ifs))                    (SOME(F.LET(map #1 args, F.RET vs, body), od), ifs))
350    
# Line 354  Line 362 
362                   in                   in
363                       inlineWitness := true;                       inlineWitness := true;
364                       (*  say ("\nInlining "^(C.LVarString g)); *)                       (*  say ("\nInlining "^(C.LVarString g)); *)
365                       (app (unuseval (undertake m)) vs) handle x => raise x;                       (app (unuseval m) vs) handle x => raise x;
366                       (C.unuse (undertake m) true g) handle x => raise x;                       unusecall m g;
367                       (SOME(nle, od),                       (SOME(nle, od),
368                        (* gross hack: to prevent further unrolling,                        (* gross hack: to prevent further unrolling,
369                         * I pretend that the rest is not inside the body *)                         * I pretend that the rest is not inside the body *)
# Line 492  Line 500 
500                             (* I could almost reuse `substitute' but the                             (* I could almost reuse `substitute' but the
501                              * unuse in substitute assumes the val is escaping *)                              * unuse in substitute assumes the val is escaping *)
502                             C.transfer(f, g);                             C.transfer(f, g);
503                             C.unuse (undertake m) true g;                             unusecall m g;
504                             (addbind(m, f, svg), fs, f::hs)                             (addbind(m, f, svg), fs, f::hs)
505                         end                         end
506                         (* the default case could ensure the inline *)                         (* the default case could ensure the inline *)
# Line 635  Line 643 
643        | F.SWITCH (v,ac,arms,def) =>        | F.SWITCH (v,ac,arms,def) =>
644          (case ((val2sval m v) handle x => raise x)          (case ((val2sval m v) handle x => raise x)
645            of sv as Con (lvc,v,dc1,tycs1) =>            of sv as Con (lvc,v,dc1,tycs1) =>
646               let fun killle le = ((#1 (C.unuselexp (undertake m))) le) handle x => raise x               let fun killle le = C.unuselexp (undertake m) le
647                   fun kill lv le =                   fun kill lv le =
648                       ((#1 (C.unuselexp (undertake (addbind(m,lv,Var(lv,NONE)))))) le) handle x => raise x                       C.unuselexp (undertake (addbind(m,lv,Var(lv,NONE)))) le
649                   fun killarm (F.DATAcon(_,_,lv),le) = kill lv le                   fun killarm (F.DATAcon(_,_,lv),le) = kill lv le
650                     | killarm _ = buglexp("bad arm in switch(con)", le)                     | killarm _ = buglexp("bad arm in switch(con)", le)
651    
# Line 658  Line 666 
666               end               end
667    
668             | sv as Val v =>             | sv as Val v =>
669               let fun kill le = ((#1 (C.unuselexp (undertake m))) le) handle x => raise x               let fun kill le = C.unuselexp (undertake m) le
670                   fun carm ((con,le)::tl) =                   fun carm ((con,le)::tl) =
671                       if eqConV(con, v) then                       if eqConV(con, v) then
672                            (map (kill o #2) tl;                            (map (kill o #2) tl;
# Line 684  Line 692 
692                    in                    in
693                        if used lv then                        if used lv then
694                            F.SWITCH(nv,ac,[(F.DATAcon(ndc,tycs,lv),nle)],NONE)                            F.SWITCH(nv,ac,[(F.DATAcon(ndc,tycs,lv),nle)],NONE)
695                        else (unuseval (undertake m) nv; nle)                        else (unuseval m nv; nle)
696                    end                    end
697                  | (([(_,le)],NONE) | ([],SOME le)) =>                  | (([(_,le)],NONE) | ([],SOME le)) =>
698                    (* This should never happen, but we can optimize it away *)                    (* This should never happen, but we can optimize it away *)
699                    (unuseval (undertake m) (sval2val sv); loop m le cont)                    (unuseval m (sval2val sv); loop m le cont)
700                  | _ =>                  | _ =>
701                    let fun carm (F.DATAcon(dc,tycs,lv),le) =                    let fun carm (F.DATAcon(dc,tycs,lv),le) =
702                            let val ndc = cdcon dc                            let val ndc = cdcon dc
# Line 767  Line 775 
775                  of SOME v =>                  of SOME v =>
776                     let val sv = (val2sval m v) handle x => raise x                     let val sv = (val2sval m v) handle x => raise x
777                     in loop (substitute(m, lv, sv, F.INT 0)) le cont                     in loop (substitute(m, lv, sv, F.INT 0)) le cont
778                             before app (unuseval (undertake m)) vs                             before app (unuseval m) vs
779                     end                     end
780                   | _ =>                   | _ =>
781                     let val nvs = map sval2val svs                     let val nvs = map sval2val svs

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