[commit: ghc] master: Don't print out undefined coercions (7d90364)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7d9036448a394d7f2eeb158bb71d0fa694f88f56/ghc

>---------------------------------------------------------------

commit 7d9036448a394d7f2eeb158bb71d0fa694f88f56
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Oct 18 15:36:37 2018 +0100

    Don't print out undefined coercions
    
    A debug-print was trying to print the coercion returned
    by the flattener.  But that coercion can be undefined
    in the case of Derived constraints.  Because we might
    rewrite it with [D] a ~ ty, and there is no evidence
    for that.
    
    Solution: don't attempt to print the coercion.


>---------------------------------------------------------------

7d9036448a394d7f2eeb158bb71d0fa694f88f56
 compiler/typecheck/TcCanonical.hs | 3 ++-
 compiler/typecheck/TcFlatten.hs   | 3 +++
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index a0932ac..b576fc3 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -1773,6 +1773,7 @@ canCFunEqCan :: CtEvidence
 canCFunEqCan ev fn tys fsk
   = do { (tys', cos, kind_co) <- flattenArgsNom ev fn tys
                         -- cos :: tys' ~ tys
+
        ; let lhs_co  = mkTcTyConAppCo Nominal fn cos
                         -- :: F tys' ~ F tys
              new_lhs = mkTyConApp fn tys'
@@ -1780,7 +1781,7 @@ canCFunEqCan ev fn tys fsk
              flav    = ctEvFlavour ev
        ; (ev', fsk')
            <- if isTcReflexiveCo kind_co   -- See Note [canCFunEqCan]
-              then do { traceTcS "canCFunEqCan: refl" (ppr new_lhs $$ ppr lhs_co)
+              then do { traceTcS "canCFunEqCan: refl" (ppr new_lhs)
                       ; let fsk_ty = mkTyVarTy fsk
                       ; ev' <- rewriteEqEvidence ev NotSwapped new_lhs fsk_ty
                                                  lhs_co (mkTcNomReflCo fsk_ty)
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 5c9bdd9..add0a6f 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -772,6 +772,9 @@ flattenArgsNom :: CtEvidence -> TyCon -> [TcType] -> TcS ([Xi], [TcCoercion], Tc
 -- and we want to flatten all at nominal role
 -- The kind passed in is the kind of the type family or class, call it T
 -- The last coercion returned has type (typeKind(T xis) ~N typeKind(T tys))
+--
+-- For Derived constraints the returned coercion may be undefined
+-- because flattening may use a Derived equality ([D] a ~ ty)
 flattenArgsNom ev tc tys
   = do { traceTcS "flatten_args {" (vcat (map ppr tys))
        ; (tys', cos, kind_co)