diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-12-14 13:27:52 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-12-14 13:27:57 +0000 |
| commit | fa1afcde4a3f9caaa0ac37e94f1d8fa3e624405f (patch) | |
| tree | f719f936c5b86128704cfede5a67a074e20571be /compiler | |
| parent | b1ea0475894713b9fc753bf288589e0dc3175083 (diff) | |
| download | haskell-fa1afcde4a3f9caaa0ac37e94f1d8fa3e624405f.tar.gz | |
Better tc-trace messages
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/typecheck/TcHsType.hs | 10 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 14 |
2 files changed, 13 insertions, 11 deletions
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index bf08b7ef61..a9e8afd1a5 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -840,8 +840,10 @@ tcInferApps :: TcTyMode -> [LHsType GhcRn] -- ^ Args -> TcM (TcType, [TcType], TcKind) -- ^ (f args, args, result kind) tcInferApps mode mb_kind_info orig_hs_ty fun_ty fun_ki orig_hs_args - = do { traceTc "tcInferApps" (ppr orig_hs_ty $$ ppr orig_hs_args $$ ppr fun_ki) - ; go 1 [] empty_subst fun_ty orig_ki_binders orig_inner_ki orig_hs_args } + = do { traceTc "tcInferApps {" (ppr orig_hs_ty $$ ppr orig_hs_args $$ ppr fun_ki) + ; stuff <- go 1 [] empty_subst fun_ty orig_ki_binders orig_inner_ki orig_hs_args + ; traceTc "tcInferApps }" empty + ; return stuff } where empty_subst = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfType fun_ki @@ -877,10 +879,6 @@ tcInferApps mode mb_kind_info orig_hs_ty fun_ty fun_ki orig_hs_args , ppr subst ]) ; arg' <- addErrCtxt (funAppCtxt orig_hs_ty arg n) $ tc_lhs_type mode arg (substTy subst $ tyBinderType ki_binder) - ; traceTc "tcInferApps (vis2)" (vcat [ ppr ki_binder, ppr arg - , ppr arg', ppr (typeKind arg') - , ppr (substTy subst $ tyBinderType ki_binder) - , ppr subst ]) ; let subst' = extendTvSubstBinderAndInScope subst ki_binder arg' ; go (n+1) (arg' : acc_args) subst' (mkNakedAppTy fun arg') ki_binders inner_ki args } diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs index 113fb9ddc7..00f23f930d 100644 --- a/compiler/typecheck/TcTyClsDecls.hs +++ b/compiler/typecheck/TcTyClsDecls.hs @@ -152,7 +152,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds = do { let role_annots = mkRoleAnnotEnv roles -- Step 1: Typecheck the type/class declarations - ; traceTc "-------- tcTyClGroup ------------" empty + ; traceTc "---- tcTyClGroup ---- {" empty ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds)) ; tyclss <- tcTyClDecls tyclds role_annots @@ -172,6 +172,8 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; mapM_ (recoverM (return ()) . checkValidRoleAnnots role_annots) tyclss -- See Note [Check role annotations in a second pass] + ; traceTc "---- end tcTyClGroup ---- }" empty + -- Step 3: Add the implicit things; -- we want them in the environment because -- they may be mentioned in interface files @@ -379,7 +381,7 @@ kcTyClGroup :: [LTyClDecl GhcRn] -> TcM [TcTyCon] -- the arity kcTyClGroup decls = do { mod <- getModule - ; traceTc "kcTyClGroup" (text "module" <+> ppr mod $$ vcat (map ppr decls)) + ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls)) -- Kind checking; -- 1. Bind kind variables for decls @@ -403,7 +405,7 @@ kcTyClGroup decls -- Now we have to kind generalize the flexis ; res <- concatMapM (generaliseTCD (tcl_env lcl_env)) decls - ; traceTc "kcTyClGroup result" (vcat (map pp_res res)) + ; traceTc "---- kcTyClGroup end ---- }" (vcat (map pp_res res)) ; return res } where @@ -807,8 +809,10 @@ tcTyClDecl roles_info (L loc decl) | otherwise = setSrcSpan loc $ tcAddDeclCtxt decl $ - do { traceTc "tcTyAndCl-x" (ppr decl) - ; tcTyClDecl1 Nothing roles_info decl } + do { traceTc "---- tcTyClDecl ---- {" (ppr decl) + ; tc <- tcTyClDecl1 Nothing roles_info decl + ; traceTc "---- tcTyClDecl end ---- }" (ppr tc) + ; return tc } -- "type family" declarations tcTyClDecl1 :: Maybe Class -> RolesInfo -> TyClDecl GhcRn -> TcM TyCon |