X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcSMonad.lhs;h=b2ce381707d34cd3b89aa21b751b196710b188e9;hp=647f22f9a6e025e35ccb908c93562a82a5c6c219;hb=58339b06aff704834e8553faaa2db00d746b26f3;hpb=fa7b383da0665fbb9c4a102507b16b02d1b3b77b diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 647f22f..b2ce381 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -82,6 +82,7 @@ import qualified TcRnMonad as TcM import qualified TcMType as TcM import qualified TcEnv as TcM ( checkWellStaged, topIdLvl, tcLookupFamInst, tcGetDefaultTys ) +import Kind import TcType import DynFlags @@ -97,16 +98,18 @@ import Outputable import Bag import MonadUtils import VarSet +import Pair import FastString import HsBinds -- for TcEvBinds stuff import Id - import TcRnTypes +import Data.IORef + #ifdef DEBUG +import StaticFlags( opt_PprStyle_Debug ) import Control.Monad( when ) #endif -import Data.IORef \end{code} @@ -206,9 +209,9 @@ instance Outputable CanonicalCt where ppr (CIPCan ip fl ip_nm ty) = ppr fl <+> ppr ip <+> dcolon <+> parens (ppr ip_nm <> dcolon <> ppr ty) ppr (CTyEqCan co fl tv ty) - = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (mkTyVarTy tv, ty) + = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (Pair (mkTyVarTy tv) ty) ppr (CFunEqCan co fl tc tys ty) - = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (mkTyConApp tc tys, ty) + = ppr fl <+> ppr co <+> dcolon <+> pprEqPred (Pair (mkTyConApp tc tys) ty) ppr (CFrozenErr co fl) = ppr fl <+> pprEvVarWithType co \end{code} @@ -527,7 +530,7 @@ runTcS context untouch tcs #ifdef DEBUG ; count <- TcM.readTcRef step_count - ; when (count > 0) $ + ; when (opt_PprStyle_Debug && count > 0) $ TcM.debugDumpTcRn (ptext (sLit "Constraint solver steps =") <+> int count <+> ppr context) #endif @@ -676,7 +679,7 @@ checkWellStagedDFun pred dfun_id loc bind_lvl = TcM.topIdLvl dfun_id pprEq :: TcType -> TcType -> SDoc -pprEq ty1 ty2 = pprPred $ mkEqPred (ty1,ty2) +pprEq ty1 ty2 = pprPredTy $ mkEqPred (ty1,ty2) isTouchableMetaTyVar :: TcTyVar -> TcS Bool isTouchableMetaTyVar tv