[commit: ghc] wip/rae-new-coercible: Change kick_out_eq to match statement of proof. (d9e7055)
git at git.haskell.org
git at git.haskell.org
Fri Dec 12 19:08:34 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/rae-new-coercible
Link : http://ghc.haskell.org/trac/ghc/changeset/d9e7055ce46b2368e34f5084ae23f767105c9cdb/ghc
>---------------------------------------------------------------
commit d9e7055ce46b2368e34f5084ae23f767105c9cdb
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Fri Dec 12 10:40:31 2014 -0500
Change kick_out_eq to match statement of proof.
>---------------------------------------------------------------
d9e7055ce46b2368e34f5084ae23f767105c9cdb
compiler/typecheck/TcInteract.hs | 43 +++++++++++++++++++++-------------------
1 file changed, 23 insertions(+), 20 deletions(-)
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index 18ca682..8949dc7 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -1014,26 +1014,29 @@ kick_out new_flavour new_eq_rel new_tv (IC { inert_eqs = tv_eqs
[] -> acc_in
(eq1:_) -> extendVarEnv acc_in (cc_tyvar eq1) eqs_in)
where
- (eqs_out, eqs_in) = partition kick_out_eq eqs
-
- -- kick_out_eq implements kick-out criteria (K1-3)
- -- in the main theorem of Note [The inert equalities] in TcFlatten
- kick_out_eq (CTyEqCan { cc_tyvar = tv, cc_rhs = rhs_ty, cc_ev = ev
- , cc_eq_rel = eq_rel })
- = can_rewrite ev
- && (tv == new_tv
- || (ev `eqCanRewrite` ev && new_tv `elemVarSet` tyVarsOfType rhs_ty)
- || exposes_new_tv eq_rel rhs_ty)
-
- kick_out_eq ct = pprPanic "kick_out_eq" (ppr ct)
-
- -- implements rule (K3) the main theorem of Note [The inert equalities]
- -- in TcFlatten
- exposes_new_tv NomEq rhs
- = case getTyVar_maybe rhs of
- Just tv_r -> tv_r == new_tv
- Nothing -> False
- exposes_new_tv ReprEq rhs = isTyVarExposed new_tv rhs
+ (eqs_in, eqs_out) = partition keep_eq eqs
+
+ -- implements criteria K1-K3 in Note [The inert equalities] in TcFlatten
+ keep_eq (CTyEqCan { cc_tyvar = tv, cc_rhs = rhs_ty, cc_ev = ev
+ , cc_eq_rel = eq_rel })
+ | tv == new_tv
+ = not (can_rewrite ev) -- (K1)
+
+ | otherwise
+ = check_k2 && check_k3
+ where
+ check_k2 = not (ev `eqCanRewrite` ev)
+ || not (can_rewrite ev)
+ || not (new_tv `elemVarSet` tyVarsOfType rhs_ty)
+
+ check_k3
+ | can_rewrite ev
+ = case eq_rel of
+ NomEq -> not (rhs_ty `eqType` mkTyVarTy new_tv)
+ ReprEq -> isTyVarExposed new_tv rhs_ty
+
+ | otherwise
+ = True
{-
Note [Kicking out inert constraints]
More information about the ghc-commits
mailing list