[commit: ghc] master: getCoerbileInsts: Move the two NT-unwrapping instances together (b6d5229)
git at git.haskell.org
git at git.haskell.org
Tue Jul 29 07:51:05 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/b6d52294cd009ef620ad9d74ab88e0822e685919/ghc
>---------------------------------------------------------------
commit b6d52294cd009ef620ad9d74ab88e0822e685919
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Jul 29 09:49:34 2014 +0200
getCoerbileInsts: Move the two NT-unwrapping instances together
and fix the numbering in the comments. Thank to SPJ for noticing.
Nothing deep in here, just a insufficent copy’n’pasting in revision
7e78faf0. Incidentially, 7e78faf0 did a better job updating the comments
than the code :-).
>---------------------------------------------------------------
b6d52294cd009ef620ad9d74ab88e0822e685919
compiler/typecheck/TcInteract.lhs | 28 ++++++++++++++--------------
1 file changed, 14 insertions(+), 14 deletions(-)
diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs
index 42e0465..2590d35 100644
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@ -1948,7 +1948,7 @@ getCoercibleInst loc ty1 ty2 = do
ev_term <- deferTcSForAllEq Representational loc (tvs1,body1) (tvs2,body2)
return $ GenInst [] ev_term
- -- Coercible NT a (see case 4 in [Coercible Instances])
+ -- Coercible NT a (see case 3 in [Coercible Instances])
| Just (tc,tyArgs) <- splitTyConApp_maybe ty1,
Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
@@ -1960,7 +1960,19 @@ getCoercibleInst loc ty1 ty2 = do
coercionToTcCoercion ntCo `mkTcTransCo` mkTcCoVarCo local_var
return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
- -- Coercible (D ty1 ty2) (D ty1' ty2') (see case 2 in [Coercible Instances])
+ -- Coercible a NT (see case 3 in [Coercible Instances])
+ | Just (tc,tyArgs) <- splitTyConApp_maybe ty2,
+ Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
+ dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
+ = do markDataConsAsUsed rdr_env tc
+ ct_ev <- requestCoercible loc ty1 concTy
+ local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy
+ let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
+ tcCo = TcLetCo binds $
+ mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo)
+ return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
+
+ -- Coercible (D ty1 ty2) (D ty1' ty2') (see case 4 in [Coercible Instances])
| Just (tc1,tyArgs1) <- splitTyConApp_maybe ty1,
Just (tc2,tyArgs2) <- splitTyConApp_maybe ty2,
tc1 == tc2,
@@ -1991,18 +2003,6 @@ getCoercibleInst loc ty1 ty2 = do
tcCo = TcLetCo binds (mkTcTyConAppCo Representational tc1 arg_cos)
return $ GenInst (catMaybes arg_new) (EvCoercion tcCo)
- -- Coercible a NT (see case 3 in [Coercible Instances])
- | Just (tc,tyArgs) <- splitTyConApp_maybe ty2,
- Just (concTy, ntCo) <- instNewTyConTF_maybe famenv tc tyArgs,
- dataConsInScope rdr_env tc -- Do not look at all tyConsOfTyCon
- = do markDataConsAsUsed rdr_env tc
- ct_ev <- requestCoercible loc ty1 concTy
- local_var <- mkSysLocalM (fsLit "coev") $ mkCoerciblePred ty1 concTy
- let binds = EvBinds (unitBag (EvBind local_var (getEvTerm ct_ev)))
- tcCo = TcLetCo binds $
- mkTcCoVarCo local_var `mkTcTransCo` mkTcSymCo (coercionToTcCoercion ntCo)
- return $ GenInst (freshGoals [ct_ev]) (EvCoercion tcCo)
-
-- Cannot solve this one
| otherwise
= return NoInstance
More information about the ghc-commits
mailing list