[commit: ghc] master: Small changes to ddump-tc tracing (3790ea9)
git at git.haskell.org
git at git.haskell.org
Thu Aug 31 07:17:27 UTC 2017
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)
More information about the ghc-commits
mailing list