[commit: ghc] wip/T9858-typeable-ben: Rip out debugging (6e0913f)

git at git.haskell.org git at git.haskell.org
Wed Oct 28 10:46:42 UTC 2015


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

On branch  : wip/T9858-typeable-ben
Link       : http://ghc.haskell.org/trac/ghc/changeset/6e0913f5f1f7b42bd444f202d86da432bd7d07d5/ghc

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

commit 6e0913f5f1f7b42bd444f202d86da432bd7d07d5
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Oct 28 11:43:51 2015 +0100

    Rip out debugging


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

6e0913f5f1f7b42bd444f202d86da432bd7d07d5
 compiler/types/FamInstEnv.hs | 13 ++-----------
 compiler/types/Unify.hs      | 10 ++++------
 2 files changed, 6 insertions(+), 17 deletions(-)

diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 1143fa7..a41e453 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -674,13 +674,11 @@ lookupFamInstEnvConflicts
 -- Precondition: the tycon is saturated (or over-saturated)
 
 lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })
-  = let ret = lookup_fam_inst_env my_unify envs fam tys
-    in pprTrace "lookupFamInstEnvConflicts(return)" (vcat [pprBranch new_branch, ppr $ null ret]) ret
+  = lookup_fam_inst_env my_unify envs fam tys
   where
     (fam, tys) = famInstSplitLHS fam_inst
         -- In example above,   fam tys' = F [b]
 
-    pprBranch br = ppr (coAxBranchLHS br) <+> char '~' <+> ppr (coAxBranchRHS br)
     my_unify (FamInst { fi_axiom = old_axiom }) tpl_tvs tpl_tys _
        = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs,
                   (ppr fam <+> ppr tys) $$
@@ -689,14 +687,7 @@ lookupFamInstEnvConflicts envs fam_inst@(FamInst { fi_axiom = new_axiom })
                 -- They shouldn't because we allocate separate uniques for them
          if compatibleBranches (coAxiomSingleBranch old_axiom) new_branch
            then Nothing
-           else pprTrace "lookupFamInstEnvConflicts"
-                (vcat [pprBranch (coAxiomSingleBranch old_axiom), pprBranch new_branch
-                      , ppr lhs1, ppr lhs2
-                      , ppr $ compatibleBranches (coAxiomSingleBranch old_axiom) new_branch
-                      , ppr $ tcUnifyTysFG instanceBindFun lhs1 lhs2]) $
-                Just noSubst
-      where lhs1 = cab_lhs $  coAxiomSingleBranch old_axiom
-            lhs2 = cab_lhs $  new_branch
+           else Just noSubst
       -- Note [Family instance overlap conflicts]
 
     noSubst = panic "lookupFamInstEnvConflicts noSubst"
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index f4e7b37..be987ae 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -577,9 +577,7 @@ unify ty1 ty2
   = if tc1 == tc2
     then if isInjectiveTyCon tc1 Nominal
          then unify_tys tys1 tys2
-         else do tmp <- runUM (unify_tys tys1 tys2)
-                 don'tBeSoSure $ pprTrace "NotSoFast" (hsep [ppr tc1, ppr tys1, ppr tc2, ppr tys2, ppr tmp]) 
-                               $ unify_tys tys1 tys2
+         else don'tBeSoSure $ unify_tys tys1 tys2
     else -- tc1 /= tc2
          if isGenerativeTyCon tc1 Nominal && isGenerativeTyCon tc2 Nominal
          then surelyApart
@@ -612,7 +610,7 @@ unify_tys orig_xs orig_ys
     go []     []     = return ()
     go (x:xs) (y:ys) = do { unify x y
                           ; go xs ys }
-    go _ _ = pprTrace "unify_tys" (hsep [ppr orig_xs, ppr orig_ys])maybeApart  -- See Note [Lists of different lengths are MaybeApart]
+    go _ _ = maybeApart  -- See Note [Lists of different lengths are MaybeApart]
 
 ---------------------------------
 uVar :: TyVar           -- Type variable to be unified
@@ -663,7 +661,7 @@ uUnrefined subst tv1 ty2 (TyVarTy tv2)
        ; b2 <- tvBindFlag tv2
        ; let ty1 = TyVarTy tv1
        ; case (b1, b2) of
-           (Skolem, Skolem) -> pprTrace "uUnrefined" (hsep [ppr tv1, ppr ty2, ppr tv2]) maybeApart -- See Note [Unification with skolems]
+           (Skolem, Skolem) -> maybeApart -- See Note [Unification with skolems]
            (BindMe, _)      -> extendSubst tv1 ty2
            (_, BindMe)      -> extendSubst tv2 ty1 }
 
@@ -683,7 +681,7 @@ bindTv :: TyVar -> Type -> UM ()
 bindTv tv ty      -- ty is not a type variable
   = do  { b <- tvBindFlag tv
         ; case b of
-            Skolem -> pprTrace "bindTv" (hsep [ppr tv, ppr ty]) maybeApart  -- See Note [Unification with skolems]
+            Skolem -> maybeApart  -- See Note [Unification with skolems]
             BindMe -> extendSubst tv ty
         }
 



More information about the ghc-commits mailing list