# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1376144020 14400
# Node ID 32784d27b5bc3750db5af41aae495e39530dbbe9
# Parent  a3d795fbecb98f1e34ab1cecc04e66fc659221a0
Expand coverage of 'functionInside' for Especialize

diff -r a3d795fbecb9 -r 32784d27b5bc src/especialize.sig
--- a/src/especialize.sig	Fri Aug 09 16:13:44 2013 -0400
+++ b/src/especialize.sig	Sat Aug 10 10:13:40 2013 -0400
@@ -29,6 +29,6 @@
 
     val specialize : Core.file -> Core.file
 
-    val functionInside : Core.con -> bool
+    val functionInside : IntBinarySet.set -> Core.con -> bool
 
 end
diff -r a3d795fbecb9 -r 32784d27b5bc src/especialize.sml
--- a/src/especialize.sml	Fri Aug 09 16:13:44 2013 -0400
+++ b/src/especialize.sml	Sat Aug 10 10:13:40 2013 -0400
@@ -122,18 +122,20 @@
 
 fun default (_, x, st) = (x, st)
 
-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
-                                          | 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 functionInside known =
+    U.Con.exists {kind = fn _ => false,
+                  con = fn TFun _ => true
+                         | TCFun _ => 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
+                         | CNamed n => IS.member (known, n)
+                         | _ => false}
 
 fun getApp (e, _) =
     case e of
@@ -216,8 +218,28 @@
     end
 
 
+fun optionExists p opt =
+    case opt of
+	NONE => false
+      | SOME v => p v
+
 fun specialize' (funcs, specialized) file =
     let
+	val known = foldl (fn (d, known) =>
+			      case #1 d of
+				  DCon (_, n, _, c) =>
+				  if functionInside known c then
+				      IS.add (known, n)
+				  else
+				      known
+				| DDatatype dts =>
+				  if List.exists (List.exists (optionExists (functionInside known) o #3) o #4) dts then
+				      foldl (fn (dt, known) => IS.add (known, #2 dt)) known dts
+				  else
+				      known
+				| _ => known)
+		    IS.empty file
+
         fun bind (env, b) =
             case b of
                 U.Decl.RelE xt => xt :: env
@@ -382,7 +404,7 @@
                                         (TFun (dom, ran), e :: xs') =>
                                         if constArgs > 0 then
                                             let
-                                                val fi = functionInside dom
+                                                val fi = functionInside known dom
                                             in
                                                 if initialPart orelse fi then
                                                     findSplit av (not fi andalso initialPart,
diff -r a3d795fbecb9 -r 32784d27b5bc src/reduce.sml
--- a/src/reduce.sml	Fri Aug 09 16:13:44 2013 -0400
+++ b/src/reduce.sml	Sat Aug 10 10:13:40 2013 -0400
@@ -558,7 +558,7 @@
                                     (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
+                                    if count b <= 1 orelse passive e2 orelse ESpecialize.functionInside IS.empty dom then
                                         let
                                             val r = exp (KnownE e2 :: env') b
                                         in
@@ -798,7 +798,7 @@
 
                                 val t = con env t
                             in
-                                if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t) then
+                                if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside IS.empty t) then
                                     exp (KnownE e1 :: env) e2
                                 else
                                     (ELet (x, t, e1', exp (UnknownE :: env) e2), loc)