Mercurial > urweb
changeset 1863:32784d27b5bc
Expand coverage of 'functionInside' for Especialize
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 10 Aug 2013 10:13:40 -0400 |
| parents | a3d795fbecb9 |
| children | 1aa9629e3a4c |
| files | src/especialize.sig src/especialize.sml src/reduce.sml |
| diffstat | 3 files changed, 38 insertions(+), 16 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- 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,
--- 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)