summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-10-25 12:48:50 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-10-25 12:48:50 -0400
commit8d179338f320dfc2b7d6a23204cf1ae90f4898ba (patch)
tree44283631b960a77b7f9f11b5a0795b4604b75a35
parentd04337d2e0319d56ac5f7ed2b4d431cb56017bb5 (diff)
Inlining threshold for Mono_reduce
-rw-r--r--src/compiler.sig1
-rw-r--r--src/compiler.sml3
-rw-r--r--src/mono_reduce.sml189
-rw-r--r--src/unnest.sml2
4 files changed, 113 insertions, 82 deletions
diff --git a/src/compiler.sig b/src/compiler.sig
index c78a2773..5192cf6e 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -139,6 +139,7 @@ signature COMPILER = sig
val toMono_reduce2 : (string, Mono.file) transform
val toMono_shake2 : (string, Mono.file) transform
val toMono_opt4 : (string, Mono.file) transform
+ val toMono_reduce3 : (string, Mono.file) transform
val toFuse2 : (string, Mono.file) transform
val toUntangle3 : (string, Mono.file) transform
val toMono_shake3 : (string, Mono.file) transform
diff --git a/src/compiler.sml b/src/compiler.sml
index 67ce962e..b1939356 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -862,7 +862,8 @@ val toUntangle2 = transform untangle "untangle2" o toFuse
val toMono_reduce2 = transform mono_reduce "mono_reduce2" o toUntangle2
val toMono_shake2 = transform mono_shake "mono_shake2" o toMono_reduce2
val toMono_opt4 = transform mono_opt "mono_opt4" o toMono_shake2
-val toFuse2 = transform fuse "shake2" o toMono_opt4
+val toMono_reduce3 = transform mono_reduce "mono_reduce3" o toMono_opt4
+val toFuse2 = transform fuse "shake2" o toMono_reduce3
val toUntangle3 = transform untangle "untangle3" o toFuse2
val toMono_shake3 = transform mono_shake "mono_shake3" o toUntangle3
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index b07f81b6..40d3c9e5 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -337,6 +337,23 @@ fun reduce file =
end)
(IS.empty, IS.empty, IM.empty) file
+ val uses = U.File.fold {typ = fn (_, m) => m,
+ exp = fn (e, m) =>
+ case e of
+ ENamed n => IM.insert (m, n, 1 + Option.getOpt (IM.find (m, n), 0))
+ | _ => m,
+ decl = fn (_, m) => m}
+ IM.empty file
+
+ val size = U.Exp.fold {typ = fn (_, n) => n,
+ exp = fn (_, n) => n + 1} 0
+
+ fun mayInline (n, e) =
+ case IM.find (uses, n) of
+ NONE => false
+ | SOME count => count <= 1
+ orelse size e <= Settings.getMonoInline ()
+
fun summarize d (e, _) =
let
val s =
@@ -452,6 +469,84 @@ fun reduce file =
let
(*val () = Print.prefaces "exp" [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))]*)
+ fun doLet (x, t, e', b) =
+ let
+ fun doSub () =
+ let
+ val r = subExpInExp (0, e') b
+ in
+ (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
+ ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+ ("r", MonoPrint.p_exp env r)];*)
+ #1 (reduceExp env r)
+ end
+
+ fun trySub () =
+ ((*Print.prefaces "trySub"
+ [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*)
+ case t of
+ (TFfi ("Basis", "string"), _) => doSub ()
+ | (TSignal _, _) => e
+ | _ =>
+ case e' of
+ (ECase _, _) => e
+ | _ => doSub ())
+ in
+ if impure env e' then
+ let
+ val effs_e' = summarize 0 e'
+ val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
+ val effs_b = summarize 0 b
+
+ (*val () = Print.prefaces "Try"
+ [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),
+ ("e'", MonoPrint.p_exp env e'),
+ ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+ ("e'_eff", p_events effs_e'),
+ ("b_eff", p_events effs_b)]*)
+
+ fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
+ val writesPage = does WritePage
+ val readsDb = does ReadDb
+ val writesDb = does WriteDb
+
+ fun verifyUnused eff =
+ case eff of
+ UseRel => false
+ | _ => true
+
+ fun verifyCompatible effs =
+ case effs of
+ [] => false
+ | eff :: effs =>
+ case eff of
+ Unsure => false
+ | UseRel => List.all verifyUnused effs
+ | WritePage => not writesPage andalso verifyCompatible effs
+ | ReadDb => not writesDb andalso verifyCompatible effs
+ | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
+ in
+ (*Print.prefaces "verifyCompatible"
+ [("e'", MonoPrint.p_exp env e'),
+ ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
+ ("effs_e'", Print.p_list p_event effs_e'),
+ ("effs_b", Print.p_list p_event effs_b)];*)
+ if (List.null effs_e'
+ orelse (List.all (fn eff => eff <> Unsure) effs_e'
+ andalso verifyCompatible effs_b)
+ orelse (case effs_b of
+ UseRel :: effs => List.all verifyUnused effs
+ | _ => false))
+ andalso countFree 0 0 b = 1
+ andalso not (freeInAbs b) then
+ trySub ()
+ else
+ e
+ end
+ else
+ trySub ()
+ end
+
val r =
case e of
ERel n =>
@@ -546,90 +641,14 @@ fun reduce file =
#1 (reduceExp env (ELet (x, t, e,
(EApp (b, liftExpInExp 0 e'), loc)), loc))
- | ELet (x, t, e', (EAbs (x', t' as (TRecord [], _), ran, e''), loc)) =>
+ | ELet (x, t, e', b as (EAbs (x', t' as (TRecord [], _), ran, e''), loc)) =>
if impure env e' then
- e
+ doLet (x, t, e', b)
else
EAbs (x', t', ran, reduceExp (E.pushERel env x' t' NONE)
(ELet (x, t, liftExpInExp 0 e', swapExpVars 0 e''), loc))
- | ELet (x, t, e', b) =>
- let
- fun doSub () =
- let
- val r = subExpInExp (0, e') b
- in
- (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
- ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
- ("r", MonoPrint.p_exp env r)];*)
- #1 (reduceExp env r)
- end
-
- fun trySub () =
- ((*Print.prefaces "trySub"
- [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan))];*)
- case t of
- (TFfi ("Basis", "string"), _) => doSub ()
- | (TSignal _, _) => e
- | _ =>
- case e' of
- (ECase _, _) => e
- | _ => doSub ())
- in
- if impure env e' then
- let
- val effs_e' = summarize 0 e'
- val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
- val effs_b = summarize 0 b
-
- (*val () = Print.prefaces "Try"
- [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
- ("e'", MonoPrint.p_exp env e'),
- ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
- ("e'_eff", p_events effs_e'),
- ("b", p_events effs_b)]*)
-
- fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
- val writesPage = does WritePage
- val readsDb = does ReadDb
- val writesDb = does WriteDb
-
- fun verifyUnused eff =
- case eff of
- UseRel => false
- | _ => true
-
- fun verifyCompatible effs =
- case effs of
- [] => false
- | eff :: effs =>
- case eff of
- Unsure => false
- | UseRel => List.all verifyUnused effs
- | WritePage => not writesPage andalso verifyCompatible effs
- | ReadDb => not writesDb andalso verifyCompatible effs
- | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
- in
- (*Print.prefaces "verifyCompatible"
- [("e'", MonoPrint.p_exp env e'),
- ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
- ("effs_e'", Print.p_list p_event effs_e'),
- ("effs_b", Print.p_list p_event effs_b)];*)
- if (List.null effs_e'
- orelse (List.all (fn eff => eff <> Unsure) effs_e'
- andalso verifyCompatible effs_b)
- orelse (case effs_b of
- UseRel :: effs => List.all verifyUnused effs
- | _ => false))
- andalso countFree 0 0 b = 1
- andalso not (freeInAbs b) then
- trySub ()
- else
- e
- end
- else
- trySub ()
- end
+ | ELet (x, t, e', b) => doLet (x, t, e', b)
| EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) =>
EPrim (Prim.String (s1 ^ s2))
@@ -648,7 +667,17 @@ fun reduce file =
case b of
U.Decl.Datatype (x, n, xncs) => E.pushDatatype env x n xncs
| U.Decl.RelE (x, t) => E.pushERel env x t NONE
- | U.Decl.NamedE (x, n, t, eo, s) => E.pushENamed env x n t (Option.map (reduceExp env) eo) s
+ | U.Decl.NamedE (x, n, t, eo, s) =>
+ let
+ val eo = case eo of
+ NONE => NONE
+ | SOME e => if mayInline (n, e) then
+ SOME e
+ else
+ NONE
+ in
+ E.pushENamed env x n t (Option.map (reduceExp env) eo) s
+ end
and reduceExp env = U.Exp.mapB {typ = typ, exp = exp, bind = bind} env
diff --git a/src/unnest.sml b/src/unnest.sml
index e0245c6f..a4bdb7a9 100644
--- a/src/unnest.sml
+++ b/src/unnest.sml
@@ -339,7 +339,7 @@ fun exp ((ks, ts), e as old, st : state) =
(*Print.prefaces "Have a vi"
[("x", Print.PD.string x),
("e", ElabPrint.p_exp ElabEnv.empty e)];*)
- (x, n, t, e)
+ ("$" ^ x, n, t, e)
end)
vis