diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2010-11-28 15:06:11 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2010-11-28 15:06:11 -0500 |
| commit | ff7dc0ebff740afc3654817f4e08e6b098fd1db2 (patch) | |
| tree | b82a6a5411e4f68d81cf57f1d179759cf22f60b6 /src/cjr_print.sml | |
| parent | 99fdcac63e9a5a55a95c31ef569f025d2f25876d (diff) | |
More accurate/conservative leaky type detection in CjrPrint
Diffstat (limited to 'src/cjr_print.sml')
| -rw-r--r-- | src/cjr_print.sml | 10 |
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 |