Mercurial > urweb
changeset 1289:3b22c3c67f35
Reduce: Inline let-bound variables whose types involve functions
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 22 Aug 2010 13:43:46 -0400 |
| parents | fc7ecf8883b1 |
| children | 6791454653c5 |
| files | src/especialize.sig src/especialize.sml src/reduce.sml src/reduce_local.sml src/sources |
| diffstat | 5 files changed, 33 insertions(+), 23 deletions(-) [+] |
line wrap: on
line diff
--- a/src/especialize.sig Sat Aug 21 10:58:13 2010 -0400 +++ b/src/especialize.sig Sun Aug 22 13:43:46 2010 -0400 @@ -29,4 +29,6 @@ val specialize : Core.file -> Core.file + val functionInside : Core.con -> bool + end
--- a/src/especialize.sml Sat Aug 21 10:58:13 2010 -0400 +++ b/src/especialize.sml Sun Aug 22 13:43:46 2010 -0400 @@ -127,6 +127,18 @@ val mayNotSpec = ref SS.empty +val functionInside = U.Con.exists {kind = fn _ => false, + con = fn TFun _ => true + | CFfi ("Basis", "transaction") => true + | CFfi ("Basis", "eq") => true + | CFfi ("Basis", "num") => true + | CFfi ("Basis", "ord") => true + | CFfi ("Basis", "show") => true + | CFfi ("Basis", "read") => true + | CFfi ("Basis", "sql_injectable_prim") => true + | CFfi ("Basis", "sql_injectable") => true + | _ => false} + fun specialize' (funcs, specialized) file = let fun bind (env, b) = @@ -286,17 +298,6 @@ (*val () = Print.prefaces "Consider" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))]*) - val functionInside = U.Con.exists {kind = fn _ => false, - con = fn TFun _ => true - | CFfi ("Basis", "transaction") => true - | CFfi ("Basis", "eq") => true - | CFfi ("Basis", "num") => true - | CFfi ("Basis", "ord") => true - | CFfi ("Basis", "show") => true - | CFfi ("Basis", "read") => true - | CFfi ("Basis", "sql_injectable_prim") => true - | CFfi ("Basis", "sql_injectable") => true - | _ => false} val loc = ErrorMsg.dummySpan fun findSplit av (xs, typ, fxs, fvs, fin) =
--- a/src/reduce.sml Sat Aug 21 10:58:13 2010 -0400 +++ b/src/reduce.sml Sun Aug 22 13:43:46 2010 -0400 @@ -652,7 +652,14 @@ | EClosure (n, es) => (EClosure (n, map (exp env) es), loc) | ELet (x, t, e1, e2) => - (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc) + let + val t = con env t + in + if ESpecialize.functionInside t then + exp (KnownE e1 :: env) e2 + else + (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc) + end | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc) in
--- a/src/reduce_local.sml Sat Aug 21 10:58:13 2010 -0400 +++ b/src/reduce_local.sml Sun Aug 22 13:43:46 2010 -0400 @@ -136,7 +136,7 @@ let fun find (n', env, nudge, liftC) = case env of - [] => raise Fail "Reduce.con: CRel" + [] => raise Fail "ReduceLocal.con: CRel" | Unknown :: rest => find (n', rest, nudge, liftC) | Known _ :: rest => find (n', rest, nudge, liftC) | Lift (liftC', _) :: rest => find (n', rest, nudge + liftC',
--- a/src/sources Sat Aug 21 10:58:13 2010 -0400 +++ b/src/sources Sun Aug 22 13:43:46 2010 -0400 @@ -107,14 +107,20 @@ corify.sig corify.sml -reduce.sig -reduce.sml +reduce_local.sig +reduce_local.sml shake.sig shake.sml -reduce_local.sig -reduce_local.sml +core_untangle.sig +core_untangle.sml + +especialize.sig +especialize.sml + +reduce.sig +reduce.sml unpoly.sig unpoly.sml @@ -122,12 +128,6 @@ specialize.sig specialize.sml -core_untangle.sig -core_untangle.sml - -especialize.sig -especialize.sml - rpcify.sig rpcify.sml