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
 [smlnj] / sml / trunk / src / compiler / FLINT / opt / fcontract.sml

# Diff of /sml/trunk/src/compiler/FLINT/opt/fcontract.sml

revision 202, Sun Dec 13 02:29:45 1998 UTC revision 203, Sat Dec 19 20:51:39 1998 UTC
# Line 292  Line 292
292  (*  val c_dropargs       = Stats.newCounter[] *)  (*  val c_dropargs       = Stats.newCounter[] *)
293      val c_cstarg = Stats.newCounter[]      val c_cstarg = Stats.newCounter[]
294      val c_outofscope = Stats.newCounter[]      val c_outofscope = Stats.newCounter[]
295      val _ = Stats.registerStat(Stats.newStat("FC-cstarg", [c_cstarg]))  (* (*      val _ = Stats.registerStat(Stats.newStat("FC-cstarg", [c_cstarg])) *) *)
296      val _ = Stats.registerStat(Stats.newStat("FC-outofscope", [c_outofscope]))  (* (*      val _ = Stats.registerStat(Stats.newStat("FC-outofscope", [c_outofscope])) *) *)
297
298  fun contract (fdec as (_,f,_,_), counter) = let  fun contract (fdec as (_,f,_,_), counter) = let
299
# Line 525  Line 525
525              in f bs              in f bs
526              end *)              end *)
527          (* The actual function contraction *)          (* The actual function contraction *)
528          fun fcFun (m,[],acc) = acc          fun fcFun ((f,body,args,fk as {inline,cconv,known,isrec},actuals),
529            | fcFun (m,(f,body,args,fk as {inline,cconv,known,isrec},actuals)::fs,                     (m,fs)) =
acc) =
530              let val fi = C.get f              let val fi = C.get f
531              in if C.dead fi then fcFun(m, fs, acc)              in if C.dead fi then (m,fs)
532                 else if C.iusenb fi = C.usenb fi then                 else if C.iusenb fi = C.usenb fi then
533                     (* we need to be careful that undertake not be called                     (* we need to be careful that undertake not be called
534                      * recursively *)                      * recursively *)
535                     (C.use NONE fi; undertake m f; fcFun(m, fs, acc))                     (C.use NONE fi; undertake m f; (m,fs))
536                 else                 else
537                     let (*  val _ = say ("\nEntering "^(C.LVarString f)) *)                     let (*  val _ = say ("\nEntering "^(C.LVarString f)) *)
538                         val saved_ic = inline_count()                         val saved_ic = inline_count()
# Line 560  Line 559
559                          * gets inlined afterwards, the counts will reflect the                          * gets inlined afterwards, the counts will reflect the
560                          * new contracted code while we'll be working on the                          * new contracted code while we'll be working on the
561                          * the old uncontracted code *)                          * the old uncontracted code *)
562                         val nm = if null fs then nm else                         val nm = addbind(m, f, Fun(f, nbody, args, nfk, ref []))
563                             addbind(m, f, Fun(f, nbody, args, nfk, ref []))                     in (nm, (nfk, f, args, nbody)::fs)
in fcFun(nm, fs, (nfk, f, args, nbody)::acc)
564                     (*  before say ("\nExiting "^(C.LVarString f)) *)                     (*  before say ("\nExiting "^(C.LVarString f)) *)
565                     end                     end
566              end              end
# Line 642  Line 640
640                          (* if some args are not used, let's drop them *)                          (* if some args are not used, let's drop them *)
641                          if not (List.all (fn x => x) used) then                          if not (List.all (fn x => x) used) then
642                              (click_dropargs();                              (click_dropargs();
643                               dropargs (fn xs => OU.filter(used, xs)))                               dropargs (fn xs => OU.filter used xs))
644
645                          (* eta-split: add a wrapper for escaping uses *)                          (* eta-split: add a wrapper for escaping uses *)
646                          else if C.escaping gi then                          else if C.escaping gi then
# Line 665  Line 663
663          (* check for eta redexes *)          (* check for eta redexes *)
664          val (nm,fs,_) = foldl fcEta (nm,[],[]) fs          val (nm,fs,_) = foldl fcEta (nm,[],[]) fs
665
666          (* move the inlinable functions to the end of the list *)          val (funs,wrappers) =
val (f1s,f2s) =
667              List.partition (fn (_,_,_,{inline=F.IH_ALWAYS,...},_) => true              List.partition (fn (_,_,_,{inline=F.IH_ALWAYS,...},_) => true
668                               | _ => false) fs                               | _ => false) fs
669          val fs = f2s @ f1s          val (funs,maybes) =
670                List.partition (fn (_,_,_,{inline=F.IH_MAYBE _,...},_) => true
671                                 | _ => false) funs
672
673          (* contract the main body *)          (* contract the main body *)
674          val nle = loop nm le cont          val nle = loop nm le cont
675          (* contract the functions *)          (* contract the functions *)
676          val fs = fcFun(nm, fs, [])          val fs = []
677            val (nm,fs) = foldl fcFun (nm,fs) funs
678            val (nm,fs) = foldl fcFun (nm,fs) maybes
679            val (nm,fs) = foldl fcFun (nm,fs) wrappers
680          (* junk newly unused funs *)          (* junk newly unused funs *)
681          val fs = List.filter (used o #2) fs          val fs = List.filter (used o #2) fs
682      in      in
# Line 683  Line 685
685            | [f1 as ({isrec=NONE,...},_,_,_),f2] =>            | [f1 as ({isrec=NONE,...},_,_,_),f2] =>
686              (* gross hack: `wrap' might have added a second              (* gross hack: `wrap' might have added a second
687               * non-recursive function.  we need to split them into               * non-recursive function.  we need to split them into
688               * 2 FIXes.  This is _very_ ad-hoc.  We know that the wrapper               * 2 FIXes.  This is _very_ ad-hoc. *)
689               * ("wrap") is inlinable while the main function ("fun") isn't,              F.FIX([f1], F.FIX([f2], nle))
* so `wrap' is in f1s and `fun' is in f2s.  Hence `wrap' is after
* `fun' when passed to fcFun which inverts the order, so
* f1 is `wrap' and f2 is `fun'. *)
F.FIX([f2], F.FIX([f1], nle))
690            | _ => F.FIX(fs, nle)            | _ => F.FIX(fs, nle)
691      end      end
692

Legend:
 Removed from v.202 changed lines Added in v.203

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