changeset 1805:d12192c7aa3e

Revert last changeset for now; needs more thought
author Adam Chlipala <adam@chlipala.net>
date Sun, 05 Aug 2012 17:11:39 -0400
parents 62c18ecbfec4
children 40557fb08e98
files src/especialize.sml src/mono_reduce.sml src/monoize.sml src/reduce.sml tests/badInline.ur
diffstat 5 files changed, 39 insertions(+), 99 deletions(-) [+]
line wrap: on
line diff
--- a/src/especialize.sml	Sun Aug 05 14:55:28 2012 -0400
+++ b/src/especialize.sml	Sun Aug 05 17:11:39 2012 -0400
@@ -124,7 +124,6 @@
 
 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
--- a/src/mono_reduce.sml	Sun Aug 05 14:55:28 2012 -0400
+++ b/src/mono_reduce.sml	Sun Aug 05 17:11:39 2012 -0400
@@ -179,12 +179,12 @@
                 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 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 @@
                                 else
                                     e
                             end
-                        else if countFree 0 0 b > 1 andalso notValue e' then
-                            e
                         else
                             trySub ()
                     end
@@ -672,11 +659,8 @@
                                       | 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
--- a/src/monoize.sml	Sun Aug 05 14:55:28 2012 -0400
+++ b/src/monoize.sml	Sun Aug 05 17:11:39 2012 -0400
@@ -3257,29 +3257,29 @@
                         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
--- a/src/reduce.sml	Sun Aug 05 14:55:28 2012 -0400
+++ b/src/reduce.sml	Sun Aug 05 17:11:39 2012 -0400
@@ -232,21 +232,6 @@
                         ((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 @@
                                 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 @@
 
                           | 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)
--- a/tests/badInline.ur	Sun Aug 05 14:55:28 2012 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -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 <xml><body>
-  <p class={ifClass (n = 0) s1
-            (ifClass (n = 1) s2
-             (ifClass (n = 2) s3
-              null))}>Hi</p>
-</body></xml>