diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/mono_reduce.sml | 26 | ||||
| -rw-r--r-- | src/reduce.sml | 7 |
2 files changed, 21 insertions, 12 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index c633bfce..71c87095 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -537,16 +537,20 @@ fun reduce file = fun doLet (x, t, e', b) = let - val notValue = U.Exp.exists {typ = fn _ => false, - exp = fn e => - case e of - EPrim _ => false - | ECon _ => false - | ENone _ => false - | ESome _ => false - | ERecord _ => false - | _ => true} - + fun passive (e : exp) = + case #1 e of + EPrim _ => true + | ERel _ => true + | ENamed _ => true + | ECon (_, _, NONE) => true + | ECon (_, _, SOME e) => passive e + | ENone _ => true + | ESome (_, e) => passive e + | EFfi _ => true + | EAbs _ => true + | ERecord xets => List.all (passive o #2) xets + | EField (e, _) => passive e + | _ => false fun doSub () = let @@ -626,7 +630,7 @@ fun reduce file = else e end - else if countFree 0 0 b > 1 andalso notValue e' then + else if countFree 0 0 b > 1 andalso not (passive e') then e else trySub () diff --git a/src/reduce.sml b/src/reduce.sml index c5733b97..f065fe2b 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -247,6 +247,11 @@ fun passive (e : exp) = | EField (e, _, _) => passive e | _ => false +fun notFfi (t : con) = + case #1 t of + CFfi _ => false + | _ => true + fun kindConAndExp (namedC, namedE) = let fun kind env (all as (k, loc)) = @@ -793,7 +798,7 @@ fun kindConAndExp (namedC, namedE) = val t = con env t in - if passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t then + if notFfi t andalso (passive e1' orelse count e2 <= 1 orelse ESpecialize.functionInside t) then exp (KnownE e1 :: env) e2 else (ELet (x, t, e1', exp (UnknownE :: env) e2), loc) |