diff src/especialize.sml @ 1863:32784d27b5bc

Expand coverage of 'functionInside' for Especialize
author Adam Chlipala <adam@chlipala.net>
date Sat, 10 Aug 2013 10:13:40 -0400
parents 52043ad66ce7
children
line wrap: on
line diff
--- 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,