From 9f704b8c6e17c96c440fb3168a91c0bdb5cb845f Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Wed, 19 Sep 2012 18:01:22 -0400
Subject: Paranoid inlining prevention for FFI types at the Core level; less
 paranoid inlining promotion for passive values at the Mono level

---
 src/mono_reduce.sml | 26 +++++++++++++++-----------
 src/reduce.sml      |  7 ++++++-
 2 files changed, 21 insertions(+), 12 deletions(-)

(limited to 'src')

diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index c633bfce..71c87095 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -537,16 +537,20 @@ 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 passive (e : exp) =
+                            case #1 e of
+                                EPrim _ => true
+                              | ERel _ => true
+                              | ENamed _ => true
+                              | ECon (_, _, NONE) => true
+                              | ECon (_, _, SOME e) => passive e
+                              | ENone _ => true
+                              | ESome (_, e) => passive e
+                              | EFfi _ => true
+                              | EAbs _ => true
+                              | ERecord xets => List.all (passive o #2) xets
+                              | EField (e, _) => passive e
+                              | _ => false
 
                         fun doSub () =
                             let
@@ -626,7 +630,7 @@ fun reduce file =
                                 else
                                     e
                             end
-                        else if countFree 0 0 b > 1 andalso notValue e' then
+                        else if countFree 0 0 b > 1 andalso not (passive e') then
                             e
                         else
                             trySub ()
diff --git a/src/reduce.sml b/src/reduce.sml
index c5733b97..f065fe2b 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -247,6 +247,11 @@ fun passive (e : exp) =
       | EField (e, _, _) => passive e
       | _ => false
 
+fun notFfi (t : con) =
+    case #1 t of
+        CFfi _ => false
+      | _ => true
+
 fun kindConAndExp (namedC, namedE) =
     let
         fun kind env (all as (k, loc)) =
@@ -793,7 +798,7 @@ fun kindConAndExp (namedC, namedE) =
 
                                 val t = con env t
                             in
-                                if passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t then
+                                if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t) then
                                     exp (KnownE e1 :: env) e2
                                 else
                                     (ELet (x, t, e1', exp (UnknownE :: env) e2), loc)
-- 
cgit v1.2.3