| 534 |
* recursively *) |
* recursively *) |
| 535 |
(C.use NONE fi; undertake m f; (m,fs)) |
(C.use NONE fi; undertake m f; (m,fs)) |
| 536 |
else |
else |
| 537 |
let (* val _ = say ("\nEntering "^(C.LVarString f)) *) |
let (* val _ = say ("Entering "^(C.LVarString f)^"\n") *) |
| 538 |
val saved_ic = inline_count() |
val saved_ic = inline_count() |
| 539 |
(* make up the bindings for args inside the body *) |
(* make up the bindings for args inside the body *) |
| 540 |
val actuals = if isSome isrec orelse |
val actuals = if isSome isrec orelse |
| 561 |
* the old uncontracted code *) |
* the old uncontracted code *) |
| 562 |
val nm = addbind(m, f, Fun(f, nbody, args, nfk, ref [])) |
val nm = addbind(m, f, Fun(f, nbody, args, nfk, ref [])) |
| 563 |
in (nm, (nfk, f, args, nbody)::fs) |
in (nm, (nfk, f, args, nbody)::fs) |
| 564 |
(* before say ("\nExiting "^(C.LVarString f)) *) |
(* before say ("Exiting "^(C.LVarString f)^"\n") *) |
| 565 |
end |
end |
| 566 |
end |
end |
| 567 |
|
|
| 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 |
val (funs,wrappers) = |
val (wrappers,funs) = |
| 667 |
List.partition (fn (_,_,_,{inline=F.IH_ALWAYS,...},_) => true |
List.partition (fn (_,_,_,{inline=F.IH_ALWAYS,...},_) => true |
| 668 |
| _ => false) fs |
| _ => false) fs |
| 669 |
val (funs,maybes) = |
val (maybes,funs) = |
| 670 |
List.partition (fn (_,_,_,{inline=F.IH_MAYBE _,...},_) => true |
List.partition (fn (_,_,_,{inline=F.IH_MAYBE _,...},_) => true |
| 671 |
| _ => false) funs |
| _ => false) funs |
| 672 |
|
|
| 673 |
(* contract the main body *) |
(* First contract the big inlinable functions. This might make them |
| 674 |
val nle = loop nm le cont |
* non-inlinable and we'd rather know that before we inline them. |
| 675 |
(* contract the functions *) |
* Then we inline the body (so that we won't go through the inline-once |
| 676 |
|
* functions twice), then the normal functions and finally the wrappers |
| 677 |
|
* (which need to come last to make sure that they get inlined if |
| 678 |
|
* at all possible) *) |
| 679 |
val fs = [] |
val fs = [] |
|
val (nm,fs) = foldl fcFun (nm,fs) funs |
|
| 680 |
val (nm,fs) = foldl fcFun (nm,fs) maybes |
val (nm,fs) = foldl fcFun (nm,fs) maybes |
| 681 |
|
val nle = loop nm le cont |
| 682 |
|
val (nm,fs) = foldl fcFun (nm,fs) funs |
| 683 |
val (nm,fs) = foldl fcFun (nm,fs) wrappers |
val (nm,fs) = foldl fcFun (nm,fs) wrappers |
| 684 |
(* junk newly unused funs *) |
(* junk newly unused funs *) |
| 685 |
val fs = List.filter (used o #2) fs |
val fs = List.filter (used o #2) fs |
| 690 |
(* gross hack: `wrap' might have added a second |
(* gross hack: `wrap' might have added a second |
| 691 |
* non-recursive function. we need to split them into |
* non-recursive function. we need to split them into |
| 692 |
* 2 FIXes. This is _very_ ad-hoc. *) |
* 2 FIXes. This is _very_ ad-hoc. *) |
| 693 |
F.FIX([f1], F.FIX([f2], nle)) |
F.FIX([f2], F.FIX([f1], nle)) |
| 694 |
| _ => F.FIX(fs, nle) |
| _ => F.FIX(fs, nle) |
| 695 |
end |
end |
| 696 |
|
|
| 712 |
* This inlining strategy looks inoffensive enough, |
* This inlining strategy looks inoffensive enough, |
| 713 |
* but still requires some care: see comments at the |
* but still requires some care: see comments at the |
| 714 |
* begining of this file and in cfun *) |
* begining of this file and in cfun *) |
| 715 |
(click_simpleinline(); |
((* say("SimpleInline of "^(C.LVarString g)^"\n"); *) |
| 716 |
|
click_simpleinline(); |
| 717 |
ignore(C.unuse true gi); |
ignore(C.unuse true gi); |
| 718 |
loop m (F.LET(map #1 args, F.RET vs, body)) cont) |
loop m (F.LET(map #1 args, F.RET vs, body)) cont) |
| 719 |
fun copyinline () = |
fun copyinline () = |
| 733 |
let val nle = (F.LET(map #1 args, F.RET vs, body)) |
let val nle = (F.LET(map #1 args, F.RET vs, body)) |
| 734 |
val nle = C.copylexp M.empty nle |
val nle = C.copylexp M.empty nle |
| 735 |
in |
in |
| 736 |
|
(* say("CopyInline of "^(C.LVarString g)^"\n"); *) |
| 737 |
click_copyinline(); |
click_copyinline(); |
| 738 |
(app (unuseval m) vs); |
(app (unuseval m) vs); |
| 739 |
unusecall m g; |
unusecall m g; |
| 896 |
| g' (n,[]) = |
| g' (n,[]) = |
| 897 |
(case sval2lty sv |
(case sval2lty sv |
| 898 |
of SOME lty => |
of SOME lty => |
| 899 |
let val ltd = case rk |
let val ltd = |
| 900 |
of F.RK_STRUCT => LT.ltd_str |
case (rk, LT.ltp_tyc lty) |
| 901 |
| F.RK_TUPLE _ => LT.ltd_tuple |
of (F.RK_STRUCT,false) => LT.ltd_str |
| 902 |
| _ => buglexp("bogus rk",le) |
| (F.RK_TUPLE _,true) => LT.ltd_tuple |
| 903 |
|
(* we might select out of a struct |
| 904 |
|
* into a tuple or vice-versa *) |
| 905 |
|
| _ => (fn _ => []) |
| 906 |
in if length(ltd lty) = n |
in if length(ltd lty) = n |
| 907 |
then SOME sv else NONE |
then SOME sv else NONE |
| 908 |
end |
end |
| 952 |
|
|
| 953 |
fun fcPrimop (po,vs,lv,le) = |
fun fcPrimop (po,vs,lv,le) = |
| 954 |
let val lvi = C.get lv |
let val lvi = C.get lv |
| 955 |
val pure = PO.purePrimop (#2 po) |
val pure = not(PO.effect(#2 po)) |
| 956 |
in if pure andalso C.dead lvi then (click_deadval();loop m le cont) else |
in if pure andalso C.dead lvi then (click_deadval();loop m le cont) else |
| 957 |
let val nvs = map substval vs |
let val nvs = map substval vs |
| 958 |
val npo = cpo po |
val npo = cpo po |
Parent Directory
| 
Revision Log
| 
Patch
