[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