+pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n)
+pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature")
+pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
+pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
+pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition")
+pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]")
+pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature")
+pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature")
+pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature")
+pprUserTypeCtxt (ForSigCtxt n) = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
+pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
+pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma")
+
+pprSkolTvBinding :: TcTyVar -> SDoc
+-- Print info about the binding of a skolem tyvar,
+-- or nothing if we don't have anything useful to say
+pprSkolTvBinding tv
+ = ASSERT ( isTcTyVar tv )
+ quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
+ where
+ ppr_details (SkolemTv info) = ppr_skol info
+ ppr_details (FlatSkol {}) = ptext (sLit "is a flattening type variable")
+ ppr_details (MetaTv (SigTv n) _) = ptext (sLit "is bound by the type signature for")
+ <+> quotes (ppr n)
+ ppr_details (MetaTv _ _) = ptext (sLit "is a meta type variable")
+
+ ppr_skol UnkSkol = ptext (sLit "is an unknown type variable") -- Unhelpful
+ ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
+ ppr_skol info = sep [ptext (sLit "is a rigid type variable bound by"),
+ sep [pprSkolInfo info,
+ nest 2 (ptext (sLit "at") <+> ppr (getSrcLoc tv))]]
+
+pprSkolInfo :: SkolemInfo -> SDoc
+-- Complete the sentence "is a rigid type variable bound by..."
+pprSkolInfo (SigSkol ctxt) = pprUserTypeCtxt ctxt
+pprSkolInfo (IPSkol ips) = ptext (sLit "the implicit-parameter bindings for")
+ <+> pprWithCommas ppr ips
+pprSkolInfo (ClsSkol cls) = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
+pprSkolInfo InstSkol = ptext (sLit "the instance declaration")
+pprSkolInfo NoScSkol = ptext (sLit "the instance declaration (self)")
+pprSkolInfo FamInstSkol = ptext (sLit "the family instance declaration")
+pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
+pprSkolInfo ArrowSkol = ptext (sLit "the arrow form")
+pprSkolInfo (PatSkol dc _) = sep [ ptext (sLit "a pattern with constructor")
+ , ppr dc <+> dcolon <+> ppr (dataConUserType dc) ]
+pprSkolInfo (GenSkol ty) = sep [ ptext (sLit "the polymorphic type")
+ , quotes (ppr ty) ]
+
+-- UnkSkol
+-- For type variables the others are dealt with by pprSkolTvBinding.
+-- For Insts, these cases should not happen
+pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
+pprSkolInfo RuntimeUnkSkol = WARN( True, text "pprSkolInfo: RuntimeUnkSkol" ) ptext (sLit "RuntimeUnkSkol")
+
+instance Outputable MetaDetails where
+ ppr Flexi = ptext (sLit "Flexi")
+ ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection{TidyType}
+%* *
+%************************************************************************
+
+\begin{code}
+-- | This tidies up a type for printing in an error message, or in
+-- an interface file.
+--
+-- It doesn't change the uniques at all, just the print names.
+tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
+tidyTyVarBndr env@(tidy_env, subst) tyvar
+ = case tidyOccName tidy_env (getOccName name) of
+ (tidy', occ') -> ((tidy', subst'), tyvar'')
+ where
+ subst' = extendVarEnv subst tyvar tyvar''
+ tyvar' = setTyVarName tyvar name'
+ name' = tidyNameOcc name occ'
+ -- Don't forget to tidy the kind for coercions!
+ tyvar'' | isCoVar tyvar = setTyVarKind tyvar' kind'
+ | otherwise = tyvar'
+ kind' = tidyType env (tyVarKind tyvar)
+ where
+ name = tyVarName tyvar
+
+---------------
+tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
+-- ^ Add the free 'TyVar's to the env in tidy form,
+-- so that we can tidy the type they are free in
+tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
+
+---------------
+tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
+tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
+
+---------------
+tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
+-- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
+-- using the environment if one has not already been allocated. See
+-- also 'tidyTyVarBndr'
+tidyOpenTyVar env@(_, subst) tyvar
+ = case lookupVarEnv subst tyvar of
+ Just tyvar' -> (env, tyvar') -- Already substituted
+ Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
+
+---------------
+tidyType :: TidyEnv -> Type -> Type
+tidyType env@(_, subst) ty
+ = go ty
+ where
+ go (TyVarTy tv) = case lookupVarEnv subst tv of
+ Nothing -> expand tv
+ Just tv' -> expand tv'
+ go (TyConApp tycon tys) = let args = map go tys
+ in args `seqList` TyConApp tycon args
+ go (PredTy sty) = PredTy (tidyPred env sty)
+ go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
+ go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
+ go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
+ where
+ (envp, tvp) = tidyTyVarBndr env tv
+
+ -- Expand FlatSkols, the skolems introduced by flattening process
+ -- We don't want to show them in type error messages
+ expand tv | isTcTyVar tv
+ , FlatSkol ty <- tcTyVarDetails tv
+ = go ty
+ | otherwise
+ = TyVarTy tv
+
+---------------
+tidyTypes :: TidyEnv -> [Type] -> [Type]
+tidyTypes env tys = map (tidyType env) tys
+
+---------------
+tidyPred :: TidyEnv -> PredType -> PredType
+tidyPred env (IParam n ty) = IParam n (tidyType env ty)
+tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
+tidyPred env (EqPred ty1 ty2) = EqPred (tidyType env ty1) (tidyType env ty2)
+
+---------------
+-- | Grabs the free type variables, tidies them
+-- and then uses 'tidyType' to work over the type itself
+tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
+tidyOpenType env ty
+ = (env', tidyType env' ty)
+ where
+ env' = tidyFreeTyVars env (tyVarsOfType ty)
+
+---------------
+tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
+tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
+
+---------------
+-- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
+tidyTopType :: Type -> Type
+tidyTopType ty = tidyType emptyTidyEnv ty
+
+---------------