[commit: ghc] master: A bit more -ddump-tc tracing (547e4c0)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/547e4c03809e082a34d9fd844c59e4844cd323ad/ghc

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

commit 547e4c03809e082a34d9fd844c59e4844cd323ad
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Mon Aug 28 13:37:30 2017 +0100

    A bit more -ddump-tc tracing


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

547e4c03809e082a34d9fd844c59e4844cd323ad
 compiler/typecheck/TcHsType.hs     |  9 +++++++++
 compiler/typecheck/TcTyClsDecls.hs | 18 ++++++++++--------
 2 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 04e2381..034c391 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -1408,6 +1408,12 @@ kcHsTyVarBndrs name flav cusk all_kind_vars
                            -- in scope from an enclosing class, but
                            -- re-adding tvs to the env't doesn't cause
                            -- harm
+
+       ; traceTc "kcHsTyVarBndrs: cusk" $
+         vcat [ ppr name, ppr kv_ns, ppr hs_tvs, ppr dep_names
+              , ppr tc_binders, ppr (mkTyConKind tc_binders res_kind)
+              , ppr qkvs, ppr meta_tvs, ppr good_tvs, ppr final_binders ]
+
        ; return (tycon, stuff) }}
 
   | otherwise
@@ -1421,6 +1427,8 @@ kcHsTyVarBndrs name flav cusk all_kind_vars
                -- must remain lined up with the binders
              tycon = mkTcTyCon name binders res_kind
                                (scoped_kvs ++ binderVars binders) flav
+
+       ; traceTc "kcHsTyVarBndrs: not-cusk" (ppr name <+> ppr binders)
        ; return (tycon, stuff) }
   where
     open_fam = tcFlavourIsOpen flav
@@ -1793,6 +1801,7 @@ tcTyClTyVars tycon_name thing_inside
 
           -- Add the *unzonked* tyvars to the env't, because those
           -- are the ones mentioned in the source.
+       ; traceTc "tcTyClTyVars" (ppr tycon_name <+> ppr binders)
        ; tcExtendTyVarEnv scoped_tvs $
          thing_inside binders res_kind }
 
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 0974fe5..a152942 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -381,7 +381,8 @@ kcTyClGroup decls
 
                       -- Make sure kc_kind' has the final, zonked kind variables
            ; traceTc "Generalise kind" $
-             vcat [ ppr name, ppr kc_binders, ppr kvs, ppr all_binders, ppr kc_res_kind
+             vcat [ ppr name, ppr kc_binders, ppr (mkTyConKind kc_binders kc_res_kind)
+                  , ppr kvs, ppr all_binders, ppr kc_res_kind
                   , ppr all_binders', ppr kc_res_kind'
                   , ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)]
 
@@ -1630,18 +1631,18 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
                       , con_qvars = hs_qvars, con_cxt = hs_ctxt
                       , con_details = hs_details })
   = addErrCtxt (dataConCtxtName [name]) $
-    do { traceTc "tcConDecl 1" (ppr name)
-
-       -- Get hold of the existential type variables
-       -- e.g. data T a = forall (b::k) f. MkT a (f b)
-       -- Here tmpl_bndrs = {a}
-       --          hs_kvs = {k}
-       --          hs_tvs = {f,b}
+    do { -- Get hold of the existential type variables
+         -- e.g. data T a = forall (b::k) f. MkT a (f b)
+         -- Here tmpl_bndrs = {a}
+         --          hs_kvs = {k}
+         --          hs_tvs = {f,b}
        ; let (hs_kvs, hs_tvs) = case hs_qvars of
                Nothing -> ([], [])
                Just (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs })
                        -> (kvs, tvs)
 
+       ; traceTc "tcConDecl 1" (vcat [ ppr name, ppr hs_kvs, ppr hs_tvs ])
+
        ; (imp_tvs, (exp_tvs, ctxt, arg_tys, field_lbls, stricts))
            <- solveEqualities $
               tcImplicitTKBndrs hs_kvs $
@@ -2423,6 +2424,7 @@ checkValidTyConTyVars tc
                    = text "NB: Implicitly declared kind variables are put first."
                    | otherwise
                    = empty
+       ; traceTc "checkValidTyConTyVars" (ppr tc <+> ppr tvs)
        ; checkValidTelescope (pprTyVars vis_tvs) stripped_tvs extra
          `and_if_that_doesn't_error`
            -- This triggers on test case dependent/should_fail/InferDependency