diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2013-08-10 10:13:40 -0400 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2013-08-10 10:13:40 -0400 |
| commit | 9734b34421533a3a70a09629b11d7e2105ef4a1a (patch) | |
| tree | 28bfd11f2f5b4745ddfdaf6c3e42e7f70fc72b59 /src/especialize.sml | |
| parent | 93fea8aa22abe42292b2d4f8fed07900280b64be (diff) | |
Expand coverage of 'functionInside' for Especialize
Diffstat (limited to 'src/especialize.sml')
| -rw-r--r-- | src/especialize.sml | 48 |
1 files changed, 35 insertions, 13 deletions
diff --git a/src/especialize.sml b/src/especialize.sml index dac91535..7cf145cd 100644 --- a/src/especialize.sml +++ b/src/especialize.sml @@ -122,18 +122,20 @@ type state = { 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 @@ fun calcConstArgs enclosingFunctions e = 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 @@ fun specialize' (funcs, specialized) file = (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, |