[commit: ghc] wip/ttypeable: TcTypeable: Kill tracing (2fc04db)
git at git.haskell.org
git at git.haskell.org
Sun Jan 29 20:21:12 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/ttypeable
Link : http://ghc.haskell.org/trac/ghc/changeset/2fc04db5086c31c8ccdc498a9b71552558ecc376/ghc
>---------------------------------------------------------------
commit 2fc04db5086c31c8ccdc498a9b71552558ecc376
Author: Ben Gamari <ben at smart-cactus.org>
Date: Tue Dec 20 00:13:30 2016 -0500
TcTypeable: Kill tracing
>---------------------------------------------------------------
2fc04db5086c31c8ccdc498a9b71552558ecc376
compiler/typecheck/TcTypeable.hs | 20 ++++++--------------
1 file changed, 6 insertions(+), 14 deletions(-)
diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs
index 0400871..e2134b3 100644
--- a/compiler/typecheck/TcTypeable.hs
+++ b/compiler/typecheck/TcTypeable.hs
@@ -187,13 +187,7 @@ mkTypeableTyConBinds mod_id tycons
, tc' <- tc : promoted
, Just rep_id <- pure $ tyConRepId stuff tc'
]
- ; 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
+ ; gbl_env <- tcExtendGlobalValEnv tycon_rep_bndrs getGblEnv
; setGblEnv gbl_env $ foldlM (mk_typeable_binds stuff) gbl_env all_tycons }
@@ -206,7 +200,7 @@ mkPrimTypeableBinds :: TcM TcGblEnv
mkPrimTypeableBinds
= do { mod <- getModule
; if mod == gHC_TYPES
- then do { trModuleTyCon <- pprTrace "mkPrimTypeableBinds" (ppr $ map tyConName ghcPrimTypeableTyCons) $ tcLookupTyCon trModuleTyConName
+ then do { trModuleTyCon <- tcLookupTyCon trModuleTyConName
; let ghc_prim_module_id =
mkExportedVanillaId trGhcPrimModuleName
(mkTyConTy trModuleTyCon)
@@ -293,7 +287,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' = pprTrace "mk_typeable_binds" (ppr binds) $ gbl_env `addTypecheckedBinds` [binds]
+ let gbl_env' = gbl_env `addTypecheckedBinds` [binds]
setGblEnv gbl_env' $ do
promoted_reps <- mapM (mkTyConRepBinds stuff . promoteDataCon)
(tyConDataCons tycon)
@@ -309,8 +303,7 @@ tyConRepId (Stuff {..}) tycon
-- | Make typeable bindings for the given 'TyCon'.
mkTyConRepBinds :: TypeableStuff -> TyCon -> TcRn (LHsBinds Id)
mkTyConRepBinds stuff@(Stuff {..}) tycon
- = pprTrace "mkTyConRepBinds" (ppr tycon) $
- case tyConRepId stuff tycon of
+ = 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
@@ -415,7 +408,7 @@ mkTyConKindRep :: TypeableStuff -> TyCon -> TcRn (LHsExpr Id)
mkTyConKindRep (Stuff {..}) tycon = do
let bndrs = mkVarEnv $ (`zip` [0..]) $ map binderVar
$ reverse $ filter isNamedTyConBinder (tyConBinders tycon)
- pprTrace "mkTyConKeyRepBinds" (ppr tycon <+> pprType' (tyConKind tycon)) $ go bndrs (tyConResKind tycon)
+ go bndrs (tyConResKind tycon)
where
-- Compute RHS
go :: VarEnv Int -> Kind -> TcRn (LHsExpr Id)
@@ -430,8 +423,7 @@ mkTyConKindRep (Stuff {..}) tycon = do
t2' <- go bndrs t2
return $ nlHsApps (dataConWrapId kindRepAppDataCon) [t1', t2']
go _ ty | Just rr <- isTYPEApp ty
- = pprTrace "mkTyConKeyRepBinds(type)" (ppr rr) $
- return $ nlHsApps (dataConWrapId kindRepTYPEDataCon) [nlHsVar $ dataConWrapId 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
More information about the ghc-commits
mailing list