From 7765b90d25f98bd9eb0cf2998121e51d4551f733 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 22 Aug 2010 13:43:46 -0400
Subject: Reduce: Inline let-bound variables whose types involve functions

---
 src/especialize.sig  |  2 ++
 src/especialize.sml  | 23 ++++++++++++-----------
 src/reduce.sml       |  9 ++++++++-
 src/reduce_local.sml |  2 +-
 src/sources          | 20 ++++++++++----------
 5 files changed, 33 insertions(+), 23 deletions(-)

(limited to 'src')

diff --git a/src/especialize.sig b/src/especialize.sig
index df83e81b..ad2d15da 100644
--- a/src/especialize.sig
+++ b/src/especialize.sig
@@ -29,4 +29,6 @@ signature ESPECIALIZE = sig
 
     val specialize : Core.file -> Core.file
 
+    val functionInside : Core.con -> bool
+
 end
diff --git a/src/especialize.sml b/src/especialize.sml
index 3fa3ea1d..a43652d0 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -127,6 +127,18 @@ structure SS = BinarySetFn(struct
 
 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 @@ fun specialize' (funcs, specialized) file =
                             (*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 --git a/src/reduce.sml b/src/reduce.sml
index 963863e8..36c9f44e 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -652,7 +652,14 @@ fun kindConAndExp (namedC, namedE) =
                           | 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 --git a/src/reduce_local.sml b/src/reduce_local.sml
index 9370c95b..cfa6bfd8 100644
--- a/src/reduce_local.sml
+++ b/src/reduce_local.sml
@@ -136,7 +136,7 @@ fun con env (all as (c, loc)) =
          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 --git a/src/sources b/src/sources
index 7ccb39db..3efdecb4 100644
--- a/src/sources
+++ b/src/sources
@@ -107,14 +107,20 @@ core_print.sml
 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 @@ unpoly.sml
 specialize.sig
 specialize.sml
 
-core_untangle.sig
-core_untangle.sml
-
-especialize.sig
-especialize.sml
-
 rpcify.sig
 rpcify.sml
 
-- 
cgit v1.2.3