# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1282499026 14400
# Node ID 3b22c3c67f35cc9ac1f3147beb9946b0bd953375
# Parent  fc7ecf8883b1992f0474ac1f2376f0c705730aaf
Reduce: Inline let-bound variables whose types involve functions

diff -r fc7ecf8883b1 -r 3b22c3c67f35 src/especialize.sig
--- 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
diff -r fc7ecf8883b1 -r 3b22c3c67f35 src/especialize.sml
--- 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) =
diff -r fc7ecf8883b1 -r 3b22c3c67f35 src/reduce.sml
--- 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
diff -r fc7ecf8883b1 -r 3b22c3c67f35 src/reduce_local.sml
--- 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',
diff -r fc7ecf8883b1 -r 3b22c3c67f35 src/sources
--- 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