[commit: ghc] wip/ttypeable: Revert "TcTypeable: Kill tracing" (5554455)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/555445542eea4ca8ac7d811b0c0b9706eb6bf174/ghc

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

commit 555445542eea4ca8ac7d811b0c0b9706eb6bf174
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Thu Jan 19 21:12:21 2017 -0500

    Revert "TcTypeable: Kill tracing"
    
    This reverts commit 7f16ece736023cf5f28d3dbb5629564805978ec2.


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

555445542eea4ca8ac7d811b0c0b9706eb6bf174
 compiler/typecheck/TcTypeable.hs | 20 ++++++++++++++------
 1 file changed, 14 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index b33dff7..7b7e0ed 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -185,7 +185,13 @@ mkTypeableTyConBinds mod_id tycons
                                , tc' <- tc : promoted
                                , Just rep_id <- pure $ tyConRepId stuff tc'
                                ]
-       ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv
+       ; gbl_env <- pprTrace "typeable tycons" (ppr $ map (\x -> (x, tyConRepId stuff x)) all_tycons)
+                    $ pprTrace "typeable tycons'" (ppr [ (tc', promoted, tyConRepId stuff tc')
+                                                       | tc <- all_tycons
+                                                       , let promoted = map promoteDataCon (tyConDataCons tc)
+                                                       , tc' <- tc:promoted ])
+                    $ pprTrace "typeable binders" (ppr tycon_rep_bndrs) $
+                    tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv
 
        ; setGblEnv gbl_env $ foldlM (mk_typeable_binds stuff) gbl_env all_tycons }
 
@@ -198,7 +204,7 @@ mkPrimTypeableBinds :: TcM TcGblEnv
 mkPrimTypeableBinds
   = do { mod <- getModule
        ; if mod == gHC_TYPES
-           then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName
+           then do { trModuleTyCon <- pprTrace "mkPrimTypeableBinds" (ppr $ map tyConName ghcPrimTypeableTyCons) $ tcLookupTyCon trModuleTyConName
                    ; let ghc_prim_module_id =
                              mkExportedVanillaId trGhcPrimModuleName
                                                  (mkTyConTy trModuleTyCon)
@@ -279,7 +285,7 @@ mkTrNameLit = do
 mk_typeable_binds :: TypeableStuff -> TcGblEnv -> TyCon -> TcM TcGblEnv
 mk_typeable_binds stuff gbl_env tycon
   = do binds <- mkTyConRepBinds stuff tycon
-       let gbl_env' = gbl_env `addTypecheckedBinds` [binds]
+       let gbl_env' = pprTrace "mk_typeable_binds" (ppr binds) $ gbl_env `addTypecheckedBinds` [binds]
        setGblEnv gbl_env' $ do
             promoted_reps <- mapM (mkTyConRepBinds stuff . promoteDataCon)
                                   (tyConDataCons tycon)
@@ -295,7 +301,8 @@ tyConRepId (Stuff {..}) tycon
 -- | Make typeable bindings for the given 'TyCon'.
 mkTyConRepBinds :: TypeableStuff -> TyCon -> TcRn (LHsBinds Id)
 mkTyConRepBinds stuff@(Stuff {..}) tycon
-  = case tyConRepId stuff tycon of
+  = pprTrace "mkTyConRepBinds" (ppr tycon) $
+    case tyConRepId stuff tycon of
       Just tycon_rep_id -> do
           tycon_rep_rhs <- mkTyConRepTyConRHS stuff tycon
           let tycon_rep = mkVarBind tycon_rep_id tycon_rep_rhs
@@ -399,7 +406,7 @@ mkTyConKindRep :: TypeableStuff -> TyCon -> TcRn (LHsExpr Id)
 mkTyConKindRep (Stuff {..}) tycon = do
     let bndrs = mkVarEnv $ (`zip` [0..]) $ map binderVar
                 $ reverse $ filter isNamedTyConBinder (tyConBinders tycon)
-    go bndrs (tyConResKind tycon)
+    pprTrace "mkTyConKeyRepBinds" (ppr tycon <+> pprType' (tyConKind tycon)) $ go bndrs (tyConResKind tycon)
   where
     -- Compute RHS
     go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id)
@@ -414,7 +421,8 @@ mkTyConKindRep (Stuff {..}) tycon = do
            t2' <- go bndrs t2
            return $ nlHsApps (dataConWrapId kindRepAppDataCon) [t1', t2']
     go _ ty | Just rr <- isTYPEApp ty
-      = return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr]
+      = pprTrace "mkTyConKeyRepBinds(type)" (ppr rr) $
+        return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId rr]
     go bndrs (TyConApp tycon tys)
       | Just rep_name <- tyConRepName_maybe tycon
       = do rep_id <- lookupId rep_name