[commit: ghc] master: Small changes to ddump-tc tracing (3790ea9)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/3790ea906da400cd7ff6dbc0ec061bd99afaf84a/ghc

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

commit 3790ea906da400cd7ff6dbc0ec061bd99afaf84a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Aug 30 16:16:36 2017 +0100

    Small changes to ddump-tc tracing


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

3790ea906da400cd7ff6dbc0ec061bd99afaf84a
 compiler/typecheck/Inst.hs         | 9 +++++----
 compiler/typecheck/TcTyClsDecls.hs | 2 +-
 compiler/typecheck/TcUnify.hs      | 7 +++++--
 compiler/types/Type.hs             | 2 +-
 4 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index bb2b90c..69f0005 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -48,7 +48,7 @@ import CoreSyn     ( isOrphan )
 import FunDeps
 import TcMType
 import Type
-import TyCoRep     ( TyBinder(..) )
+import TyCoRep
 import TcType
 import HscTypes
 import Class( Class )
@@ -196,15 +196,16 @@ top_instantiate inst_all orig ty
        ; let inst_theta' = substTheta subst inst_theta
              sigma'      = substTy subst (mkForAllTys leave_bndrs $
                                           mkFunTys leave_theta rho)
+             inst_tv_tys' = mkTyVarTys inst_tvs'
 
-       ; wrap1 <- instCall orig (mkTyVarTys inst_tvs') inst_theta'
+       ; wrap1 <- instCall orig inst_tv_tys' inst_theta'
        ; traceTc "Instantiating"
                  (vcat [ text "all tyvars?" <+> ppr inst_all
                        , text "origin" <+> pprCtOrigin orig
-                       , text "type" <+> ppr ty
+                       , text "type" <+> debugPprType ty
                        , text "theta" <+> ppr theta
                        , text "leave_bndrs" <+> ppr leave_bndrs
-                       , text "with" <+> ppr inst_tvs'
+                       , text "with" <+> vcat (map debugPprType inst_tv_tys')
                        , text "theta:" <+>  ppr inst_theta' ])
 
        ; (wrap2, rho2) <-
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 01baa6f..f445d83 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -2506,7 +2506,7 @@ checkValidDataCon dflags existential_ok tc con
           --                data T = MkT {-# UNPACK #-} !a      -- Can't unpack
         ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..]
 
-        ; traceTc "Done validity of data con" (ppr con <+> ppr (dataConRepType con))
+        ; traceTc "Done validity of data con" (ppr con <+> debugPprType (dataConRepType con))
     }
   where
     ctxt = ConArgCtxt (dataConName con)
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 59f8869..56cc95d 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -1280,8 +1280,11 @@ uType_defer t_or_k origin ty1 ty2
        ; whenDOptM Opt_D_dump_tc_trace $ do
             { ctxt <- getErrCtxt
             ; doc <- mkErrInfo emptyTidyEnv ctxt
-            ; traceTc "utype_defer" (vcat [ppr co, ppr ty1,
-                                           ppr ty2, pprCtOrigin origin, doc])
+            ; traceTc "utype_defer" (vcat [ debugPprType ty1
+                                          , debugPprType ty2
+                                          , pprCtOrigin origin
+                                          , doc])
+            ; traceTc "utype_defer2" (ppr co)
             }
        ; return co }
 
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 1e0c612..b0f1fac 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -687,7 +687,7 @@ splitAppTy_maybe ty | Just ty' <- coreView ty
 splitAppTy_maybe ty = repSplitAppTy_maybe ty
 
 -------------
-repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
+repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)
 -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that
 -- any Core view stuff is already done
 repSplitAppTy_maybe (FunTy ty1 ty2)