From 5b530665813a1041554357f6eca2c6ac36e2e26b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 5 Aug 2012 17:11:39 -0400 Subject: Revert last changeset for now; needs more thought --- src/especialize.sml | 1 - src/mono_reduce.sml | 24 ++++------------------- src/monoize.sml | 46 ++++++++++++++++++++++---------------------- src/reduce.sml | 55 ++++++++++++----------------------------------------- tests/badInline.ur | 12 ------------ 5 files changed, 39 insertions(+), 99 deletions(-) delete mode 100644 tests/badInline.ur diff --git a/src/especialize.sml b/src/especialize.sml index a3d59ef9..d6bf7eba 100644 --- a/src/especialize.sml +++ b/src/especialize.sml @@ -124,7 +124,6 @@ fun default (_, x, st) = (x, st) val functionInside = U.Con.exists {kind = fn _ => false, con = fn TFun _ => true - | TCFun _ => true | CFfi ("Basis", "transaction") => true | CFfi ("Basis", "eq") => true | CFfi ("Basis", "num") => true diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index af61489c..88628ac2 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -179,12 +179,12 @@ val swapExpVarsPat = bind = fn ((lower, len), U.Exp.RelE _) => (lower+1, len) | (st, _) => st} -datatype result = Yes of (string * typ * exp) list | No | Maybe +datatype result = Yes of exp list | No | Maybe fun match (env, p : pat, e : exp) = case (#1 p, #1 e) of (PWild, _) => Yes env - | (PVar (x, t), _) => Yes ((x, t, e) :: env) + | (PVar (x, t), _) => Yes (e :: env) | (PPrim (Prim.String s), EStrcat ((EPrim (Prim.String s'), _), _)) => if String.isPrefix s' s then @@ -519,17 +519,6 @@ fun reduce file = fun doLet (x, t, e', b) = let - val notValue = U.Exp.exists {typ = fn _ => false, - exp = fn e => - case e of - EPrim _ => false - | ECon _ => false - | ENone _ => false - | ESome _ => false - | ERecord _ => false - | _ => true} - - fun doSub () = let val r = subExpInExp (0, e') b @@ -608,8 +597,6 @@ fun reduce file = else e end - else if countFree 0 0 b > 1 andalso notValue e' then - e else trySub () end @@ -672,11 +659,8 @@ fun reduce file = | Yes subs => let val (body, remaining) = - foldl (fn ((x, t, e), (body, remaining)) => - (if countFree 0 0 body > 1 then - (ELet (x, t, multiLift remaining e, body), #2 e') - else - subExpInExp (0, multiLift remaining e) body, remaining - 1)) + foldl (fn (e, (body, remaining)) => + (subExpInExp (0, multiLift remaining e) body, remaining - 1)) (body, length subs - 1) subs val r = reduceExp (E.patBinds env p) body in diff --git a/src/monoize.sml b/src/monoize.sml index edc13c3f..1b9c97ed 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3257,29 +3257,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val t = (L'.TFfi ("Basis", "string"), loc) val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc) - val s = (L'.EStrcat (s, - (L'.ECase (class, - [((L'.PPrim (Prim.String ""), loc), - (L'.EPrim (Prim.String ""), loc)), - ((L'.PVar ("x", t), loc), - (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), - (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), - loc)), loc))], - {disc = t, - result = t}), loc)), loc) - - val s = (L'.EStrcat (s, - (L'.ECase (style, - [((L'.PPrim (Prim.String ""), loc), - (L'.EPrim (Prim.String ""), loc)), - ((L'.PVar ("x", t), loc), - (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), - (L'.EStrcat ((L'.ERel 0, loc), - (L'.EPrim (Prim.String "\""), loc)), - loc)), loc))], - {disc = t, - result = t}), loc)), loc) + val s = (L'.ECase (class, + [((L'.PPrim (Prim.String ""), loc), + s), + ((L'.PVar ("x", t), loc), + (L'.EStrcat (s, + (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\""), loc)), + loc)), loc)), loc))], + {disc = t, + result = t}), loc) + + val s = (L'.ECase (style, + [((L'.PPrim (Prim.String ""), loc), + s), + ((L'.PVar ("x", t), loc), + (L'.EStrcat (s, + (L'.EStrcat ((L'.EPrim (Prim.String " style=\""), loc), + (L'.EStrcat ((L'.ERel 0, loc), + (L'.EPrim (Prim.String "\""), loc)), + loc)), loc)), loc))], + {disc = t, + result = t}), loc) val (s, fm) = foldl (fn (("Action", _, _), acc) => acc | (("Source", _, _), acc) => acc diff --git a/src/reduce.sml b/src/reduce.sml index c5733b97..1fbf526d 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -232,21 +232,6 @@ fun monadRecord m loc = ((CName "Bind", loc), bindType m loc)]), loc), loc) -fun passive (e : exp) = - case #1 e of - EPrim _ => true - | ERel _ => true - | ENamed _ => true - | ECon (_, _, _, NONE) => true - | ECon (_, _, _, SOME e) => passive e - | EFfi _ => true - | EAbs _ => true - | ECAbs _ => true - | EKAbs _ => true - | ERecord xes => List.all (passive o #2) xes - | EField (e, _, _) => passive e - | _ => false - fun kindConAndExp (namedC, namedE) = let fun kind env (all as (k, loc)) = @@ -549,30 +534,16 @@ fun kindConAndExp (namedC, namedE) = val e2 = exp env e2 in case #1 e1 of - ELet (x, t, e1', e2') => - (ELet (x, t, e1', exp (UnknownE :: env') (EApp (e2', E.liftExpInExp 0 e2), loc)), loc) - - | EAbs (x, dom, _, b) => - if count b <= 1 orelse passive e2 orelse ESpecialize.functionInside dom then - let - val r = exp (KnownE e2 :: env') b - in - (*Print.prefaces "eapp" [("b", CorePrint.p_exp CoreEnv.empty b), - ("env", Print.PD.string (e2s env')), - ("e2", CorePrint.p_exp CoreEnv.empty e2), - ("r", CorePrint.p_exp CoreEnv.empty r)];*) - r - end - else - let - val dom = con env' dom - val r = exp (UnknownE :: env') b - in - (*Print.prefaces "El skippo" [("x", Print.PD.string x), - ("e2", CorePrint.p_exp CoreEnv.empty e2)];*) - (ELet (x, dom, e2, r), loc) - end - + EAbs (_, _, _, b) => + let + val r = exp (KnownE e2 :: env') b + in + (*Print.prefaces "eapp" [("b", CorePrint.p_exp CoreEnv.empty b), + ("env", Print.PD.string (e2s env')), + ("e2", CorePrint.p_exp CoreEnv.empty e2), + ("r", CorePrint.p_exp CoreEnv.empty r)];*) + r + end | ECase (e, pes, cc as {disc, result = res as (TFun (_, c2), _)}) => let val pes' = map (fn (p, body) => @@ -789,14 +760,12 @@ fun kindConAndExp (namedC, namedE) = | ELet (x, t, e1, e2) => let - val e1' = exp env e1 - val t = con env t in - if passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t then + if ESpecialize.functionInside t then exp (KnownE e1 :: env) e2 else - (ELet (x, t, e1', exp (UnknownE :: env) e2), loc) + (ELet (x, t, exp env e1, exp (UnknownE :: env) e2), loc) end | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc) diff --git a/tests/badInline.ur b/tests/badInline.ur deleted file mode 100644 index bfbdba79..00000000 --- a/tests/badInline.ur +++ /dev/null @@ -1,12 +0,0 @@ -style s1 -style s2 -style s3 - -fun ifClass r cls c = if r then classes cls c else c - -fun main (n : int) : transaction page = return -

Hi

- -- cgit v1.2.3