[commit: ghc] master: Don't mkNakedCastTy on something unsaturated (15ce9b4)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/15ce9b45515415b0cbe606e9324a7858c9009c0b/ghc

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

commit 15ce9b45515415b0cbe606e9324a7858c9009c0b
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Thu Jul 12 18:45:09 2018 -0400

    Don't mkNakedCastTy on something unsaturated
    
    A recent commit added extra calls to mkNakedCastTy to satisfy
    Note [The tcType invariant]. However, some of these casts were
    being applied to unsaturated type family applications, which
    caused ASSERTion failures in TcFlatten later on. This patch
    is more judicious in using mkNakedCastTy to avoid this problem.


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

15ce9b45515415b0cbe606e9324a7858c9009c0b
 compiler/typecheck/TcHsType.hs | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 3032e07..c9c3347 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -1211,8 +1211,16 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
            ; let (tc_kind_bndrs, tc_inner_ki) = splitPiTysInvisible tc_kind
            ; (tc_args, kind) <- instantiateTyN Nothing (length (tyConBinders tc_tc))
                                                tc_kind_bndrs tc_inner_ki
-           ; let tc_ty = mkNakedTyConApp tc tc_args `mkNakedCastTy` mkRepReflCo kind
-               -- mkNakedCastTy is for (IT5) of Note [The tcType invariant]
+           ; let is_saturated = tc_args `lengthAtLeast` tyConArity tc_tc
+                 tc_ty
+                   | is_saturated = mkNakedTyConApp tc tc_args `mkNakedCastTy` mkRepReflCo kind
+                      -- mkNakedCastTy is for (IT5) of Note [The tcType invariant]
+                   | otherwise    = mkNakedTyConApp tc tc_args
+                      -- if the tycon isn't yet saturated, then we don't want mkNakedCastTy,
+                      -- because that means we'll have an unsaturated type family
+                      -- We don't need it anyway, because we can be sure that the
+                      -- type family kind will accept further arguments (because it is
+                      -- not yet saturated)
            -- tc and tc_ty must not be traced here, because that would
            -- force the evaluation of a potentially knot-tied variable (tc),
            -- and the typechecker would hang, as per #11708
@@ -2742,7 +2750,7 @@ tcLHsKindSig ctxt hs_kind
 -- Result is zonked
   = do { kind <- solveLocalEqualities $
                  tc_lhs_kind kindLevelMode hs_kind
-       ; traceTc "tcLHsKindSig" (ppr kind)
+       ; traceTc "tcLHsKindSig" (ppr hs_kind $$ ppr kind)
        ; kind <- zonkPromoteType kind
          -- This zonk is very important in the case of higher rank kinds
          -- E.g. Trac #13879    f :: forall (p :: forall z (y::z). <blah>).