summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-11-28 15:06:11 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-11-28 15:06:11 -0500
commitff7dc0ebff740afc3654817f4e08e6b098fd1db2 (patch)
treeb82a6a5411e4f68d81cf57f1d179759cf22f60b6
parent99fdcac63e9a5a55a95c31ef569f025d2f25876d (diff)
More accurate/conservative leaky type detection in CjrPrint
-rw-r--r--src/cjr_print.sml10
1 files changed, 7 insertions, 3 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 99b42657..46de6a52 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -525,6 +525,10 @@ fun getPargs (e, _) =
| _ => raise Fail "CjrPrint: getPargs"
+val notLeakies = SS.fromList ["int", "float", "char", "time", "bool", "unit", "client", "channel",
+ "xhtml", "page", "xbody", "css_class"]
+val notLeakies' = SS.fromList ["blob"]
+
fun notLeaky env allowHeapAllocated =
let
fun nl ok (t, _) =
@@ -548,9 +552,9 @@ fun notLeaky env allowHeapAllocated =
NONE => true
| SOME t => nl ok' t) cons
end)
- | TFfi ("Basis", "string") => false
- | TFfi ("Basis", "blob") => allowHeapAllocated
- | TFfi _ => true
+ | TFfi ("Basis", t) => SS.member (notLeakies, t)
+ orelse (allowHeapAllocated andalso SS.member (notLeakies', t))
+ | TFfi _ => false
| TOption t => allowHeapAllocated andalso nl ok t
| TList (t, _) => allowHeapAllocated andalso nl ok t
in