summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-01-06 08:12:04 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-02-01 14:06:11 -0500
commitddc2a7595a28b6098b6aab61bc830f2296affcdc (patch)
tree2863cb09e18f9d2cba1ff8a4f78b6a2f6431837f /compiler/GHC/Tc
parent5464845a012bf174cfafe03aaeb2e47150e7efb5 (diff)
downloadhaskell-ddc2a7595a28b6098b6aab61bc830f2296affcdc.tar.gz
Remove ErrDoc and MsgDoc
This commit boldly removes the ErrDoc and the MsgDoc from the codebase. The former was introduced with the only purpose of classifying errors according to their importance, but a similar result can be obtained just by having a simple [SDoc], and placing bullets after each of them. On top of that I have taken the perhaps controversial decision to also banish MsgDoc, as it was merely a type alias over an SDoc and as such it wasn't offering any extra type safety. Granted, it was perhaps making type signatures slightly more "focused", but at the expense of cognitive burden: if it's really just an SDoc, let's call it with its proper name.
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r--compiler/GHC/Tc/Deriv.hs16
-rw-r--r--compiler/GHC/Tc/Deriv/Infer.hs2
-rw-r--r--compiler/GHC/Tc/Errors.hs52
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Foreign.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs6
-rw-r--r--compiler/GHC/Tc/Module.hs24
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/PatSyn.hs11
-rw-r--r--compiler/GHC/Tc/Types.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs6
-rw-r--r--compiler/GHC/Tc/Utils/Env.hs9
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs96
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Unify.hs6
-rw-r--r--compiler/GHC/Tc/Validity.hs2
17 files changed, 123 insertions, 125 deletions
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 407cb6a21b..e3dec46f91 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -2219,10 +2219,10 @@ gndNonNewtypeErr :: SDoc
gndNonNewtypeErr =
text "GeneralizedNewtypeDeriving cannot be used on non-newtypes"
-derivingNullaryErr :: MsgDoc
+derivingNullaryErr :: SDoc
derivingNullaryErr = text "Cannot derive instances for nullary classes"
-derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> MsgDoc
+derivingKindErr :: TyCon -> Class -> [Type] -> Kind -> Bool -> SDoc
derivingKindErr tc cls cls_tys cls_kind enough_args
= sep [ hang (text "Cannot derive well-kinded instance of form"
<+> quotes (pprClassPred cls cls_tys
@@ -2237,7 +2237,7 @@ derivingKindErr tc cls cls_tys cls_kind enough_args
= text "(Perhaps you intended to use PolyKinds)"
| otherwise = Outputable.empty
-derivingViaKindErr :: Class -> Kind -> Type -> Kind -> MsgDoc
+derivingViaKindErr :: Class -> Kind -> Type -> Kind -> SDoc
derivingViaKindErr cls cls_kind via_ty via_kind
= hang (text "Cannot derive instance via" <+> quotes (pprType via_ty))
2 (text "Class" <+> quotes (ppr cls)
@@ -2246,26 +2246,26 @@ derivingViaKindErr cls cls_kind via_ty via_kind
$+$ text "but" <+> quotes (pprType via_ty)
<+> text "has kind" <+> quotes (pprKind via_kind))
-derivingEtaErr :: Class -> [Type] -> Type -> MsgDoc
+derivingEtaErr :: Class -> [Type] -> Type -> SDoc
derivingEtaErr cls cls_tys inst_ty
= sep [text "Cannot eta-reduce to an instance of form",
nest 2 (text "instance (...) =>"
<+> pprClassPred cls (cls_tys ++ [inst_ty]))]
derivingThingErr :: Bool -> Class -> [Type]
- -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc
+ -> Maybe (DerivStrategy GhcTc) -> SDoc -> SDoc
derivingThingErr newtype_deriving cls cls_args mb_strat why
= derivingThingErr' newtype_deriving cls cls_args mb_strat
(maybe empty derivStrategyName mb_strat) why
-derivingThingErrM :: Bool -> MsgDoc -> DerivM MsgDoc
+derivingThingErrM :: Bool -> SDoc -> DerivM SDoc
derivingThingErrM newtype_deriving why
= do DerivEnv { denv_cls = cls
, denv_inst_tys = cls_args
, denv_strat = mb_strat } <- ask
pure $ derivingThingErr newtype_deriving cls cls_args mb_strat why
-derivingThingErrMechanism :: DerivSpecMechanism -> MsgDoc -> DerivM MsgDoc
+derivingThingErrMechanism :: DerivSpecMechanism -> SDoc -> DerivM SDoc
derivingThingErrMechanism mechanism why
= do DerivEnv { denv_cls = cls
, denv_inst_tys = cls_args
@@ -2274,7 +2274,7 @@ derivingThingErrMechanism mechanism why
(derivStrategyName $ derivSpecMechanismToStrategy mechanism) why
derivingThingErr' :: Bool -> Class -> [Type]
- -> Maybe (DerivStrategy GhcTc) -> MsgDoc -> MsgDoc -> MsgDoc
+ -> Maybe (DerivStrategy GhcTc) -> SDoc -> SDoc -> SDoc
derivingThingErr' newtype_deriving cls cls_args mb_strat strat_msg why
= sep [(hang (text "Can't make a derived instance of")
2 (quotes (ppr pred) <+> via_mechanism)
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index d65564d1da..5ce54339c6 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -700,7 +700,7 @@ simplifyInstanceContexts infer_specs
where
the_pred = mkClassPred clas inst_tys
-derivInstCtxt :: PredType -> MsgDoc
+derivInstCtxt :: PredType -> SDoc
derivInstCtxt pred
= text "When deriving the instance for" <+> parens (ppr pred)
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index fcd48c3d5c..43f6505d7b 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -750,7 +750,7 @@ mkUserTypeErrorReporter ctxt
; maybeReportError ctxt err
; addDeferredBinding ctxt err ct }
-mkUserTypeError :: ReportErrCtxt -> Ct -> TcM (ErrMsg ErrDoc)
+mkUserTypeError :: ReportErrCtxt -> Ct -> TcM (ErrMsg [SDoc])
mkUserTypeError ctxt ct = mkErrorMsgFromCt ctxt ct
$ important
$ pprUserTypeErrorTy
@@ -826,7 +826,7 @@ pattern match which binds some equality constraints. If we
find one, we report the insoluble Given.
-}
-mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc))
+mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc]))
-- Make error message for a group
-> Reporter -- Deal with lots of constraints
-- Group together errors from same location,
@@ -835,7 +835,7 @@ mkGroupReporter mk_err ctxt cts
= mapM_ (reportGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
-- Like mkGroupReporter, but doesn't actually print error messages
-mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)) -> Reporter
+mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])) -> Reporter
mkSuppressReporter mk_err ctxt cts
= mapM_ (suppressGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
@@ -853,7 +853,7 @@ cmp_loc ct1 ct2 = get ct1 `compare` get ct2
-- Reduce duplication by reporting only one error from each
-- /starting/ location even if the end location differs
-reportGroup :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)) -> Reporter
+reportGroup :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])) -> Reporter
reportGroup mk_err ctxt cts =
ASSERT( not (null cts))
do { err <- mk_err ctxt cts
@@ -872,13 +872,13 @@ reportGroup mk_err ctxt cts =
-- like reportGroup, but does not actually report messages. It still adds
-- -fdefer-type-errors bindings, though.
-suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)) -> Reporter
+suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])) -> Reporter
suppressGroup mk_err ctxt cts
= do { err <- mk_err ctxt cts
; traceTc "Suppressing errors for" (ppr cts)
; mapM_ (addDeferredBinding ctxt err) cts }
-maybeReportHoleError :: ReportErrCtxt -> Hole -> ErrMsg ErrDoc -> TcM ()
+maybeReportHoleError :: ReportErrCtxt -> Hole -> ErrMsg [SDoc] -> TcM ()
maybeReportHoleError ctxt hole err
| isOutOfScopeHole hole
-- Always report an error for out-of-scope variables
@@ -920,7 +920,7 @@ maybeReportHoleError ctxt hole err
HoleWarn -> reportWarning (Reason Opt_WarnTypedHoles) err
HoleDefer -> return ()
-maybeReportError :: ReportErrCtxt -> ErrMsg ErrDoc -> TcM ()
+maybeReportError :: ReportErrCtxt -> ErrMsg [SDoc] -> TcM ()
-- Report the error and/or make a deferred binding for it
maybeReportError ctxt err
| cec_suppress ctxt -- Some worse error has occurred;
@@ -932,7 +932,7 @@ maybeReportError ctxt err
TypeWarn reason -> reportWarning reason err
TypeError -> reportError err
-addDeferredBinding :: ReportErrCtxt -> ErrMsg ErrDoc -> Ct -> TcM ()
+addDeferredBinding :: ReportErrCtxt -> ErrMsg [SDoc] -> Ct -> TcM ()
-- See Note [Deferring coercion errors to runtime]
addDeferredBinding ctxt err ct
| deferringAnyBindings ctxt
@@ -955,14 +955,14 @@ addDeferredBinding ctxt err ct
= return ()
mkErrorTerm :: DynFlags -> Type -- of the error term
- -> ErrMsg ErrDoc -> EvTerm
+ -> ErrMsg [SDoc] -> EvTerm
mkErrorTerm dflags ty err = evDelayedError ty err_fs
where
err_msg = pprLocErrMsg err
err_fs = mkFastString $ showSDoc dflags $
err_msg $$ text "(deferred type error)"
-maybeAddDeferredHoleBinding :: ReportErrCtxt -> ErrMsg ErrDoc -> Hole -> TcM ()
+maybeAddDeferredHoleBinding :: ReportErrCtxt -> ErrMsg [SDoc] -> Hole -> TcM ()
maybeAddDeferredHoleBinding ctxt err (Hole { hole_sort = ExprHole (HER ref ref_ty _) })
-- Only add bindings for holes in expressions
-- not for holes in partial type signatures
@@ -1048,15 +1048,15 @@ pprWithArising (ct:cts)
ppr_one ct' = hang (parens (pprType (ctPred ct')))
2 (pprCtLoc (ctLoc ct'))
-mkErrorMsgFromCt :: ReportErrCtxt -> Ct -> Report -> TcM (ErrMsg ErrDoc)
+mkErrorMsgFromCt :: ReportErrCtxt -> Ct -> Report -> TcM (ErrMsg [SDoc])
mkErrorMsgFromCt ctxt ct report
= mkErrorReport ctxt (ctLocEnv (ctLoc ct)) report
-mkErrorReport :: ReportErrCtxt -> TcLclEnv -> Report -> TcM (ErrMsg ErrDoc)
+mkErrorReport :: ReportErrCtxt -> TcLclEnv -> Report -> TcM (ErrMsg [SDoc])
mkErrorReport ctxt tcl_env (Report important relevant_bindings valid_subs)
= do { context <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)
; mkErrDocAt (RealSrcSpan (tcl_loc tcl_env) Nothing)
- (errDoc important [context] (relevant_bindings ++ valid_subs))
+ [vcat important, context, vcat (relevant_bindings ++ valid_subs)]
}
type UserGiven = Implication
@@ -1153,7 +1153,7 @@ solve it.
************************************************************************
-}
-mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)
+mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])
mkIrredErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
; let orig = ctOrigin ct1
@@ -1164,7 +1164,7 @@ mkIrredErr ctxt cts
(ct1:_) = cts
----------------
-mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (ErrMsg ErrDoc)
+mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (ErrMsg [SDoc])
mkHoleError _tidy_simples _ctxt hole@(Hole { hole_occ = occ
, hole_ty = hole_ty
, hole_loc = ct_loc })
@@ -1175,9 +1175,9 @@ mkHoleError _tidy_simples _ctxt hole@(Hole { hole_occ = occ
; curr_mod <- getModule
; hpt <- getHpt
; mkErrDocAt (RealSrcSpan (tcl_loc lcl_env) Nothing) $
- errDoc [out_of_scope_msg] []
- [unknownNameSuggestions dflags hpt curr_mod rdr_env
- (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)] }
+ [out_of_scope_msg,
+ (unknownNameSuggestions dflags hpt curr_mod rdr_env
+ (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ))] }
where
herald | isDataOcc occ = text "Data constructor not in scope:"
| otherwise = text "Variable not in scope:"
@@ -1305,7 +1305,7 @@ givenConstraintsMsg ctxt =
2 (vcat $ map pprConstraint constraints)
----------------
-mkIPErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)
+mkIPErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])
mkIPErr ctxt cts
= do { (ctxt, binds_msg, ct1) <- relevantBindings True ctxt ct1
; let orig = ctOrigin ct1
@@ -1382,11 +1382,11 @@ any more. So we don't assert that it is.
-- Don't have multiple equality errors from the same location
-- E.g. (Int,Bool) ~ (Bool,Int) one error will do!
-mkEqErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)
+mkEqErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])
mkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct
mkEqErr _ [] = panic "mkEqErr"
-mkEqErr1 :: ReportErrCtxt -> Ct -> TcM (ErrMsg ErrDoc)
+mkEqErr1 :: ReportErrCtxt -> Ct -> TcM (ErrMsg [SDoc])
mkEqErr1 ctxt ct -- Wanted or derived;
-- givens handled in mkGivenErrorReporter
= do { (ctxt, binds_msg, ct) <- relevantBindings True ctxt ct
@@ -1452,7 +1452,7 @@ mkCoercibleExplanation rdr_env fam_envs ty1 ty2
mkEqErr_help :: DynFlags -> ReportErrCtxt -> Report
-> Ct
- -> TcType -> TcType -> TcM (ErrMsg ErrDoc)
+ -> TcType -> TcType -> TcM (ErrMsg [SDoc])
mkEqErr_help dflags ctxt report ct ty1 ty2
| Just (tv1, _) <- tcGetCastedTyVar_maybe ty1
= mkTyVarEqErr dflags ctxt report ct tv1 ty2
@@ -1463,7 +1463,7 @@ mkEqErr_help dflags ctxt report ct ty1 ty2
reportEqErr :: ReportErrCtxt -> Report
-> Ct
- -> TcType -> TcType -> TcM (ErrMsg ErrDoc)
+ -> TcType -> TcType -> TcM (ErrMsg [SDoc])
reportEqErr ctxt report ct ty1 ty2
= mkErrorMsgFromCt ctxt ct (mconcat [misMatch, report, eqInfo])
where
@@ -1472,7 +1472,7 @@ reportEqErr ctxt report ct ty1 ty2
mkTyVarEqErr, mkTyVarEqErr'
:: DynFlags -> ReportErrCtxt -> Report -> Ct
- -> TcTyVar -> TcType -> TcM (ErrMsg ErrDoc)
+ -> TcTyVar -> TcType -> TcM (ErrMsg [SDoc])
-- tv1 and ty2 are already tidied
mkTyVarEqErr dflags ctxt report ct tv1 ty2
= do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr ty2)
@@ -1672,7 +1672,7 @@ pp_givens givens
-- always be another unsolved wanted around, which will ordinarily suppress
-- this message. But this can still be printed out with -fdefer-type-errors
-- (sigh), so we must produce a message.
-mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)
+mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])
mkBlockedEqErr ctxt (ct:_) = mkErrorMsgFromCt ctxt ct report
where
report = important msg
@@ -2279,7 +2279,7 @@ Warn of loopy local equalities that were dropped.
************************************************************************
-}
-mkDictErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg ErrDoc)
+mkDictErr :: ReportErrCtxt -> [Ct] -> TcM (ErrMsg [SDoc])
mkDictErr ctxt cts
= ASSERT( not (null cts) )
do { inst_envs <- tcGetInstEnvs
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 62c6cb218a..c677643be5 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -230,7 +230,7 @@ tcHsBootSigs binds sigs
-- Notice that we make GlobalIds, not LocalIds
tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
-badBootDeclErr :: MsgDoc
+badBootDeclErr :: SDoc
badBootDeclErr = text "Illegal declarations in an hs-boot file"
------------------------
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 4d0c8da8e3..114e339dec 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -814,7 +814,7 @@ failWithDcErr parent child parents = do
exportClashErr :: GlobalRdrEnv
-> GreName -> GreName
-> IE GhcPs -> IE GhcPs
- -> MsgDoc
+ -> SDoc
exportClashErr global_env child1 child2 ie1 ie2
= vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon
, ppr_export child1' gre1' ie1'
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 9818642d47..b40386e513 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -542,7 +542,7 @@ checkCConv JavaScriptCallConv = do dflags <- getDynFlags
-- Warnings
-check :: Validity -> (MsgDoc -> MsgDoc) -> TcM ()
+check :: Validity -> (SDoc -> SDoc) -> TcM ()
check IsValid _ = return ()
check (NotValid doc) err_fn = addErrTc (err_fn doc)
@@ -558,7 +558,7 @@ argument, result :: SDoc
argument = text "argument"
result = text "result"
-badCName :: CLabelString -> MsgDoc
+badCName :: CLabelString -> SDoc
badCName target
= sep [quotes (ppr target) <+> text "is not a valid C identifier"]
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index e21adf31df..346000975a 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -789,7 +789,7 @@ runAnnotation target expr = do
ann_value = serialized
}
-convertAnnotationWrapper :: ForeignHValue -> TcM (Either MsgDoc Serialized)
+convertAnnotationWrapper :: ForeignHValue -> TcM (Either SDoc Serialized)
convertAnnotationWrapper fhv = do
interp <- tcGetInterp
case interp of
@@ -910,7 +910,7 @@ runMetaD = runMeta metaRequestD
---------------
runMeta' :: Bool -- Whether code should be printed in the exception message
-> (hs_syn -> SDoc) -- how to print the code
- -> (SrcSpan -> ForeignHValue -> TcM (Either MsgDoc hs_syn)) -- How to run x
+ -> (SrcSpan -> ForeignHValue -> TcM (Either SDoc hs_syn)) -- How to run x
-> LHsExpr GhcTc -- Of type x; typically x = Q TH.Exp, or
-- something like that
-> TcM hs_syn -- Of type t
@@ -1285,7 +1285,7 @@ runTH ty fhv = do
-- See Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs.
runRemoteTH
:: IServInstance
- -> [Messages ErrDoc] -- saved from nested calls to qRecover
+ -> [Messages [SDoc]] -- saved from nested calls to qRecover
-> TcM ()
runRemoteTH iserv recovers = do
THMsg msg <- liftIO $ readIServ iserv getTHMessage
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 746b5c71ea..bdcc85ef64 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -188,7 +188,7 @@ tcRnModule :: HscEnv
-> ModSummary
-> Bool -- True <=> save renamed syntax
-> HsParsedModule
- -> IO (Messages ErrDoc, Maybe TcGblEnv)
+ -> IO (Messages [SDoc], Maybe TcGblEnv)
tcRnModule hsc_env mod_sum save_rn_syntax
parsedModule@HsParsedModule {hpm_module= L loc this_module}
@@ -1986,7 +1986,7 @@ this Note.
*********************************************************
-}
-runTcInteractive :: HscEnv -> TcRn a -> IO (Messages ErrDoc, Maybe a)
+runTcInteractive :: HscEnv -> TcRn a -> IO (Messages [SDoc], Maybe a)
-- Initialise the tcg_inst_env with instances from all home modules.
-- This mimics the more selective call to hptInstances in tcRnImports
runTcInteractive hsc_env thing_inside
@@ -2102,7 +2102,7 @@ We don't bother with the tcl_th_bndrs environment either.
-- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound
-- values, coerced to ().
tcRnStmt :: HscEnv -> GhciLStmt GhcPs
- -> IO (Messages ErrDoc, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
+ -> IO (Messages [SDoc], Maybe ([Id], LHsExpr GhcTc, FixityEnv))
tcRnStmt hsc_env rdr_stmt
= runTcInteractive hsc_env $ do {
@@ -2482,7 +2482,7 @@ getGhciStepIO = do
return (noLoc $ ExprWithTySig noExtField (nlHsVar ghciStepIoMName) stepTy)
-isGHCiMonad :: HscEnv -> String -> IO (Messages ErrDoc, Maybe Name)
+isGHCiMonad :: HscEnv -> String -> IO (Messages [SDoc], Maybe Name)
isGHCiMonad hsc_env ty
= runTcInteractive hsc_env $ do
rdrEnv <- getGlobalRdrEnv
@@ -2509,7 +2509,7 @@ data TcRnExprMode = TM_Inst -- ^ Instantiate inferred quantifiers only (:typ
tcRnExpr :: HscEnv
-> TcRnExprMode
-> LHsExpr GhcPs
- -> IO (Messages ErrDoc, Maybe Type)
+ -> IO (Messages [SDoc], Maybe Type)
tcRnExpr hsc_env mode rdr_expr
= runTcInteractive hsc_env $
do {
@@ -2578,7 +2578,7 @@ has a special case for application chains.
--------------------------
tcRnImportDecls :: HscEnv
-> [LImportDecl GhcPs]
- -> IO (Messages ErrDoc, Maybe GlobalRdrEnv)
+ -> IO (Messages [SDoc], Maybe GlobalRdrEnv)
-- Find the new chunk of GlobalRdrEnv created by this list of import
-- decls. In contract tcRnImports *extends* the TcGblEnv.
tcRnImportDecls hsc_env import_decls
@@ -2594,7 +2594,7 @@ tcRnType :: HscEnv
-> ZonkFlexi
-> Bool -- Normalise the returned type
-> LHsType GhcPs
- -> IO (Messages ErrDoc, Maybe (Type, Kind))
+ -> IO (Messages [SDoc], Maybe (Type, Kind))
tcRnType hsc_env flexi normalise rdr_type
= runTcInteractive hsc_env $
setXOptM LangExt.PolyKinds $ -- See Note [Kind-generalise in tcRnType]
@@ -2728,7 +2728,7 @@ tcRnDeclsi exists to allow class, data, and other declarations in GHCi.
tcRnDeclsi :: HscEnv
-> [LHsDecl GhcPs]
- -> IO (Messages ErrDoc, Maybe TcGblEnv)
+ -> IO (Messages [SDoc], Maybe TcGblEnv)
tcRnDeclsi hsc_env local_decls
= runTcInteractive hsc_env $
tcRnSrcDecls False local_decls Nothing
@@ -2753,13 +2753,13 @@ externaliseAndTidyId this_mod id
-- a package module with an interface on disk. If neither of these is
-- true, then the result will be an error indicating the interface
-- could not be found.
-getModuleInterface :: HscEnv -> Module -> IO (Messages ErrDoc, Maybe ModIface)
+getModuleInterface :: HscEnv -> Module -> IO (Messages [SDoc], Maybe ModIface)
getModuleInterface hsc_env mod
= runTcInteractive hsc_env $
loadModuleInterface (text "getModuleInterface") mod
tcRnLookupRdrName :: HscEnv -> Located RdrName
- -> IO (Messages ErrDoc, Maybe [Name])
+ -> IO (Messages [SDoc], Maybe [Name])
-- ^ Find all the Names that this RdrName could mean, in GHCi
tcRnLookupRdrName hsc_env (L loc rdr_name)
= runTcInteractive hsc_env $
@@ -2773,7 +2773,7 @@ tcRnLookupRdrName hsc_env (L loc rdr_name)
; when (null names) (addErrTc (text "Not in scope:" <+> quotes (ppr rdr_name)))
; return names }
-tcRnLookupName :: HscEnv -> Name -> IO (Messages ErrDoc, Maybe TyThing)
+tcRnLookupName :: HscEnv -> Name -> IO (Messages [SDoc], Maybe TyThing)
tcRnLookupName hsc_env name
= runTcInteractive hsc_env $
tcRnLookupName' name
@@ -2792,7 +2792,7 @@ tcRnLookupName' name = do
tcRnGetInfo :: HscEnv
-> Name
- -> IO ( Messages ErrDoc
+ -> IO ( Messages [SDoc]
, Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
-- Used to implement :info in GHCi
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index d4e8827d3d..8bc1d3a746 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1960,7 +1960,7 @@ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id
poly_meth_ty = mkSpecSigmaTy tyvars theta local_meth_ty
theta = map idType dfun_ev_vars
-methSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
+methSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
methSigCtxt sel_name sig_ty meth_ty env0
= do { (env1, sig_ty) <- zonkTidyTcType env0 sig_ty
; (env2, meth_ty) <- zonkTidyTcType env1 meth_ty
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 43388472d7..338e24153c 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -60,7 +60,6 @@ import GHC.Types.FieldLabel
import GHC.Rename.Env
import GHC.Data.Bag
import GHC.Utils.Misc
-import GHC.Utils.Error
import GHC.Driver.Session ( getDynFlags )
import Data.Maybe( mapMaybe )
import Control.Monad ( zipWithM )
@@ -974,7 +973,7 @@ add_void need_dummy_arg ty
| otherwise = ty
tcPatToExpr :: Name -> [Located Name] -> LPat GhcRn
- -> Either MsgDoc (LHsExpr GhcRn)
+ -> Either SDoc (LHsExpr GhcRn)
-- Given a /pattern/, return an /expression/ that builds a value
-- that matches the pattern. E.g. if the pattern is (Just [x]),
-- the expression is (Just [x]). They look the same, but the
@@ -989,7 +988,7 @@ tcPatToExpr name args pat = go pat
-- Make a prefix con for prefix and infix patterns for simplicity
mkPrefixConExpr :: Located Name -> [LPat GhcRn]
- -> Either MsgDoc (HsExpr GhcRn)
+ -> Either SDoc (HsExpr GhcRn)
mkPrefixConExpr lcon@(L loc _) pats
= do { exprs <- mapM go pats
; let con = L loc (HsVar noExtField lcon)
@@ -997,15 +996,15 @@ tcPatToExpr name args pat = go pat
}
mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn)
- -> Either MsgDoc (HsExpr GhcRn)
+ -> Either SDoc (HsExpr GhcRn)
mkRecordConExpr con fields
= do { exprFields <- mapM go fields
; return (RecordCon noExtField con exprFields) }
- go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
+ go :: LPat GhcRn -> Either SDoc (LHsExpr GhcRn)
go (L loc p) = L loc <$> go1 p
- go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
+ go1 :: Pat GhcRn -> Either SDoc (HsExpr GhcRn)
go1 (ConPat NoExtField con info)
= case info of
PrefixCon _ ps -> mkPrefixConExpr con ps
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 8197220f09..4995e6702e 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -748,7 +748,7 @@ data TcLclEnv -- Changes as we move inside an expression
-- and for tidying types
tcl_lie :: TcRef WantedConstraints, -- Place to accumulate type constraints
- tcl_errs :: TcRef (Messages ErrDoc) -- Place to accumulate errors
+ tcl_errs :: TcRef (Messages [SDoc]) -- Place to accumulate errors
}
setLclEnvTcLevel :: TcLclEnv -> TcLevel -> TcLclEnv
@@ -763,7 +763,7 @@ setLclEnvLoc env loc = env { tcl_loc = loc }
getLclEnvLoc :: TcLclEnv -> RealSrcSpan
getLclEnvLoc = tcl_loc
-type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
+type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, SDoc))
-- Monadic so that we have a chance
-- to deal with bound type variables just before error
-- message construction
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 0265abef64..9e9f01aa0b 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -361,7 +361,7 @@ checkUnit (VirtUnit indef) = do
-- an @hsig@ file.)
tcRnCheckUnit ::
HscEnv -> Unit ->
- IO (Messages ErrDoc, Maybe ())
+ IO (Messages [SDoc], Maybe ())
tcRnCheckUnit hsc_env uid =
withTiming dflags
(text "Check unit id" <+> ppr uid)
@@ -381,7 +381,7 @@ tcRnCheckUnit hsc_env uid =
-- | Top-level driver for signature merging (run after typechecking
-- an @hsig@ file).
tcRnMergeSignatures :: HscEnv -> HsParsedModule -> TcGblEnv {- from local sig -} -> ModIface
- -> IO (Messages ErrDoc, Maybe TcGblEnv)
+ -> IO (Messages [SDoc], Maybe TcGblEnv)
tcRnMergeSignatures hsc_env hpm orig_tcg_env iface =
withTiming dflags
(text "Signature merging" <+> brackets (ppr this_mod))
@@ -912,7 +912,7 @@ mergeSignatures
-- an @hsig@ file.)
tcRnInstantiateSignature ::
HscEnv -> Module -> RealSrcSpan ->
- IO (Messages ErrDoc, Maybe TcGblEnv)
+ IO (Messages [SDoc], Maybe TcGblEnv)
tcRnInstantiateSignature hsc_env this_mod real_loc =
withTiming dflags
(text "Signature instantiation"<+>brackets (ppr this_mod))
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 3267a24cd6..8dcb0b47f7 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -112,7 +112,6 @@ import GHC.Unit.External
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Encoding
-import GHC.Utils.Error
import GHC.Utils.Misc ( HasDebugCallStack )
import GHC.Data.FastString
@@ -155,7 +154,7 @@ lookupGlobal hsc_env name
Failed msg -> pprPanic "lookupGlobal" msg
}
-lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)
+lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing)
-- This may look up an Id that one has previously looked up.
-- If so, we are going to read its interface file, and add its bindings
-- to the ExternalPackageTable.
@@ -174,7 +173,7 @@ lookupGlobal_maybe hsc_env name
lookupImported_maybe hsc_env name
}
-lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)
+lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing)
-- Returns (Failed err) if we can't find the interface file for the thing
lookupImported_maybe hsc_env name
= do { mb_thing <- lookupType hsc_env name
@@ -183,7 +182,7 @@ lookupImported_maybe hsc_env name
Nothing -> importDecl_maybe hsc_env name
}
-importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc TyThing)
+importDecl_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing)
importDecl_maybe hsc_env name
| Just thing <- wiredInNameTyThing_maybe name
= do { when (needWiredInHomeIface thing)
@@ -200,7 +199,7 @@ ioLookupDataCon hsc_env name = do
Succeeded thing -> return thing
Failed msg -> pprPanic "lookupDataConIO" msg
-ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr MsgDoc DataCon)
+ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc DataCon)
ioLookupDataCon_maybe hsc_env name = do
thing <- lookupGlobal hsc_env name
return $ case thing of
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 08d76b64a0..76856d7439 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -231,7 +231,7 @@ initTc :: HscEnv
-> Module
-> RealSrcSpan
-> TcM r
- -> IO (Messages ErrDoc, Maybe r)
+ -> IO (Messages [SDoc], Maybe r)
-- Nothing => error thrown by the thing inside
-- (error messages should have been printed already)
@@ -353,7 +353,7 @@ initTcWithGbl :: HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
- -> IO (Messages ErrDoc, Maybe r)
+ -> IO (Messages [SDoc], Maybe r)
initTcWithGbl hsc_env gbl_env loc do_this
= do { lie_var <- newIORef emptyWC
; errs_var <- newIORef emptyMessages
@@ -399,7 +399,7 @@ initTcWithGbl hsc_env gbl_env loc do_this
; return (msgs, final_res)
}
-initTcInteractive :: HscEnv -> TcM a -> IO (Messages ErrDoc, Maybe a)
+initTcInteractive :: HscEnv -> TcM a -> IO (Messages [SDoc], Maybe a)
-- Initialise the type checker monad for use in GHCi
initTcInteractive hsc_env thing_inside
= initTc hsc_env HsSrcFile False
@@ -588,9 +588,9 @@ getEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)
; return (eps, hsc_HPT env) }
--- | A convenient wrapper for taking a @MaybeErr MsgDoc a@ and throwing
+-- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing
-- an exception if it is an error.
-withException :: TcRnIf gbl lcl (MaybeErr MsgDoc a) -> TcRnIf gbl lcl a
+withException :: TcRnIf gbl lcl (MaybeErr SDoc a) -> TcRnIf gbl lcl a
withException do_this = do
r <- do_this
dflags <- getDynFlags
@@ -930,22 +930,22 @@ wrapLocM_ fn (L loc a) = setSrcSpan loc (fn a)
-- Reporting errors
-getErrsVar :: TcRn (TcRef (Messages ErrDoc))
+getErrsVar :: TcRn (TcRef (Messages [SDoc]))
getErrsVar = do { env <- getLclEnv; return (tcl_errs env) }
-setErrsVar :: TcRef (Messages ErrDoc) -> TcRn a -> TcRn a
+setErrsVar :: TcRef (Messages [SDoc]) -> TcRn a -> TcRn a
setErrsVar v = updLclEnv (\ env -> env { tcl_errs = v })
-addErr :: MsgDoc -> TcRn ()
+addErr :: SDoc -> TcRn ()
addErr msg = do { loc <- getSrcSpanM; addErrAt loc msg }
-failWith :: MsgDoc -> TcRn a
+failWith :: SDoc -> TcRn a
failWith msg = addErr msg >> failM
-failAt :: SrcSpan -> MsgDoc -> TcRn a
+failAt :: SrcSpan -> SDoc -> TcRn a
failAt loc msg = addErrAt loc msg >> failM
-addErrAt :: SrcSpan -> MsgDoc -> TcRn ()
+addErrAt :: SrcSpan -> SDoc -> TcRn ()
-- addErrAt is mainly (exclusively?) used by the renamer, where
-- tidying is not an issue, but it's all lazy so the extra
-- work doesn't matter
@@ -954,16 +954,16 @@ addErrAt loc msg = do { ctxt <- getErrCtxt
; err_info <- mkErrInfo tidy_env ctxt
; addLongErrAt loc msg err_info }
-addErrs :: [(SrcSpan,MsgDoc)] -> TcRn ()
+addErrs :: [(SrcSpan,SDoc)] -> TcRn ()
addErrs msgs = mapM_ add msgs
where
add (loc,msg) = addErrAt loc msg
-checkErr :: Bool -> MsgDoc -> TcRn ()
+checkErr :: Bool -> SDoc -> TcRn ()
-- Add the error if the bool is False
checkErr ok msg = unless ok (addErr msg)
-addMessages :: Messages ErrDoc -> TcRn ()
+addMessages :: Messages [SDoc] -> TcRn ()
addMessages msgs1
= do { errs_var <- getErrsVar ;
msgs0 <- readTcRef errs_var ;
@@ -992,36 +992,36 @@ discardWarnings thing_inside
************************************************************************
-}
-mkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn (ErrMsg ErrDoc)
+mkLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn (ErrMsg [SDoc])
mkLongErrAt loc msg extra
= do { printer <- getPrintUnqualified ;
unit_state <- hsc_units <$> getTopEnv ;
let msg' = pprWithUnitState unit_state msg in
return $ mkLongErrMsg loc printer msg' extra }
-mkErrDocAt :: SrcSpan -> ErrDoc -> TcRn (ErrMsg ErrDoc)
+mkErrDocAt :: SrcSpan -> [SDoc] -> TcRn (ErrMsg [SDoc])
mkErrDocAt loc errDoc
= do { printer <- getPrintUnqualified ;
unit_state <- hsc_units <$> getTopEnv ;
let f = pprWithUnitState unit_state
- errDoc' = mapErrDoc f errDoc
+ errDoc' = map f errDoc
in
return $ mkErr loc printer errDoc' }
-addLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
+addLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn ()
addLongErrAt loc msg extra = mkLongErrAt loc msg extra >>= reportError
-reportErrors :: [ErrMsg ErrDoc] -> TcM ()
+reportErrors :: [ErrMsg [SDoc]] -> TcM ()
reportErrors = mapM_ reportError
-reportError :: ErrMsg ErrDoc -> TcRn ()
+reportError :: ErrMsg [SDoc] -> TcRn ()
reportError err
= do { traceTc "Adding error:" (pprLocErrMsg err) ;
errs_var <- getErrsVar ;
msgs <- readTcRef errs_var ;
writeTcRef errs_var (err `addMessage` msgs) }
-reportWarning :: WarnReason -> ErrMsg ErrDoc -> TcRn ()
+reportWarning :: WarnReason -> ErrMsg [SDoc] -> TcRn ()
reportWarning reason err
= do { let warn = makeIntoWarning reason err
-- 'err' was built by mkLongErrMsg or something like that,
@@ -1100,12 +1100,12 @@ setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt })
-- | Add a fixed message to the error context. This message should not
-- do any tidying.
-addErrCtxt :: MsgDoc -> TcM a -> TcM a
+addErrCtxt :: SDoc -> TcM a -> TcM a
{-# INLINE addErrCtxt #-} -- Note [Inlining addErrCtxt]
addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))
-- | Add a message to the error context. This message may do tidying.
-addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a
+addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
{-# INLINE addErrCtxtM #-} -- Note [Inlining addErrCtxt]
addErrCtxtM ctxt m = updCtxt (push_ctxt (False, ctxt)) m
@@ -1113,17 +1113,17 @@ addErrCtxtM ctxt m = updCtxt (push_ctxt (False, ctxt)) m
-- message is always sure to be reported, even if there is a lot of
-- context. It also doesn't count toward the maximum number of contexts
-- reported.
-addLandmarkErrCtxt :: MsgDoc -> TcM a -> TcM a
+addLandmarkErrCtxt :: SDoc -> TcM a -> TcM a
{-# INLINE addLandmarkErrCtxt #-} -- Note [Inlining addErrCtxt]
addLandmarkErrCtxt msg = addLandmarkErrCtxtM (\env -> return (env, msg))
-- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations
-- and tidying.
-addLandmarkErrCtxtM :: (TidyEnv -> TcM (TidyEnv, MsgDoc)) -> TcM a -> TcM a
+addLandmarkErrCtxtM :: (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
{-# INLINE addLandmarkErrCtxtM #-} -- Note [Inlining addErrCtxt]
addLandmarkErrCtxtM ctxt m = updCtxt (push_ctxt (True, ctxt)) m
-push_ctxt :: (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
+push_ctxt :: (Bool, TidyEnv -> TcM (TidyEnv, SDoc))
-> Bool -> [ErrCtxt] -> [ErrCtxt]
push_ctxt ctxt in_gen ctxts
| in_gen = ctxts
@@ -1191,7 +1191,7 @@ capture_constraints thing_inside
; lie <- readTcRef lie_var
; return (res, lie) }
-capture_messages :: TcM r -> TcM (r, Messages ErrDoc)
+capture_messages :: TcM r -> TcM (r, Messages [SDoc])
-- capture_messages simply captures and returns the
-- errors arnd warnings generated by thing_inside
-- Precondition: thing_inside must not throw an exception!
@@ -1361,7 +1361,7 @@ foldAndRecoverM f acc (x:xs) =
Just acc' -> foldAndRecoverM f acc' xs }
-----------------------
-tryTc :: TcRn a -> TcRn (Maybe a, Messages ErrDoc)
+tryTc :: TcRn a -> TcRn (Maybe a, Messages [SDoc])
-- (tryTc m) executes m, and returns
-- Just r, if m succeeds (returning r)
-- Nothing, if m fails
@@ -1414,11 +1414,11 @@ tryTcDiscardingErrs recover thing_inside
tidy up the message; we then use it to tidy the context messages
-}
-addErrTc :: MsgDoc -> TcM ()
+addErrTc :: SDoc -> TcM ()
addErrTc err_msg = do { env0 <- tcInitTidyEnv
; addErrTcM (env0, err_msg) }
-addErrTcM :: (TidyEnv, MsgDoc) -> TcM ()
+addErrTcM :: (TidyEnv, SDoc) -> TcM ()
addErrTcM (tidy_env, err_msg)
= do { ctxt <- getErrCtxt ;
loc <- getSrcSpanM ;
@@ -1426,27 +1426,27 @@ addErrTcM (tidy_env, err_msg)
-- The failWith functions add an error message and cause failure
-failWithTc :: MsgDoc -> TcM a -- Add an error message and fail
+failWithTc :: SDoc -> TcM a -- Add an error message and fail
failWithTc err_msg
= addErrTc err_msg >> failM
-failWithTcM :: (TidyEnv, MsgDoc) -> TcM a -- Add an error message and fail
+failWithTcM :: (TidyEnv, SDoc) -> TcM a -- Add an error message and fail
failWithTcM local_and_msg
= addErrTcM local_and_msg >> failM
-checkTc :: Bool -> MsgDoc -> TcM () -- Check that the boolean is true
+checkTc :: Bool -> SDoc -> TcM () -- Check that the boolean is true
checkTc True _ = return ()
checkTc False err = failWithTc err
-checkTcM :: Bool -> (TidyEnv, MsgDoc) -> TcM ()
+checkTcM :: Bool -> (TidyEnv, SDoc) -> TcM ()
checkTcM True _ = return ()
checkTcM False err = failWithTcM err
-failIfTc :: Bool -> MsgDoc -> TcM () -- Check that the boolean is false
+failIfTc :: Bool -> SDoc -> TcM () -- Check that the boolean is false
failIfTc False _ = return ()
failIfTc True err = failWithTc err
-failIfTcM :: Bool -> (TidyEnv, MsgDoc) -> TcM ()
+failIfTcM :: Bool -> (TidyEnv, SDoc) -> TcM ()
-- Check that the boolean is false
failIfTcM False _ = return ()
failIfTcM True err = failWithTcM err
@@ -1456,59 +1456,59 @@ failIfTcM True err = failWithTcM err
-- | Display a warning if a condition is met,
-- and the warning is enabled
-warnIfFlag :: WarningFlag -> Bool -> MsgDoc -> TcRn ()
+warnIfFlag :: WarningFlag -> Bool -> SDoc -> TcRn ()
warnIfFlag warn_flag is_bad msg
= do { warn_on <- woptM warn_flag
; when (warn_on && is_bad) $
addWarn (Reason warn_flag) msg }
-- | Display a warning if a condition is met.
-warnIf :: Bool -> MsgDoc -> TcRn ()
+warnIf :: Bool -> SDoc -> TcRn ()
warnIf is_bad msg
= when is_bad (addWarn NoReason msg)
-- | Display a warning if a condition is met.
-warnTc :: WarnReason -> Bool -> MsgDoc -> TcM ()
+warnTc :: WarnReason -> Bool -> SDoc -> TcM ()
warnTc reason warn_if_true warn_msg
| warn_if_true = addWarnTc reason warn_msg
| otherwise = return ()
-- | Display a warning if a condition is met.
-warnTcM :: WarnReason -> Bool -> (TidyEnv, MsgDoc) -> TcM ()
+warnTcM :: WarnReason -> Bool -> (TidyEnv, SDoc) -> TcM ()
warnTcM reason warn_if_true warn_msg
| warn_if_true = addWarnTcM reason warn_msg
| otherwise = return ()
-- | Display a warning in the current context.
-addWarnTc :: WarnReason -> MsgDoc -> TcM ()
+addWarnTc :: WarnReason -> SDoc -> TcM ()
addWarnTc reason msg
= do { env0 <- tcInitTidyEnv ;
addWarnTcM reason (env0, msg) }
-- | Display a warning in a given context.
-addWarnTcM :: WarnReason -> (TidyEnv, MsgDoc) -> TcM ()
+addWarnTcM :: WarnReason -> (TidyEnv, SDoc) -> TcM ()
addWarnTcM reason (env0, msg)
= do { ctxt <- getErrCtxt ;
err_info <- mkErrInfo env0 ctxt ;
add_warn reason msg err_info }
-- | Display a warning for the current source location.
-addWarn :: WarnReason -> MsgDoc -> TcRn ()
+addWarn :: WarnReason -> SDoc -> TcRn ()
addWarn reason msg = add_warn reason msg Outputable.empty
-- | Display a warning for a given source location.
-addWarnAt :: WarnReason -> SrcSpan -> MsgDoc -> TcRn ()
+addWarnAt :: WarnReason -> SrcSpan -> SDoc -> TcRn ()
addWarnAt reason loc msg = add_warn_at reason loc msg Outputable.empty
-- | Display a warning, with an optional flag, for the current source
-- location.
-add_warn :: WarnReason -> MsgDoc -> MsgDoc -> TcRn ()
+add_warn :: WarnReason -> SDoc -> SDoc -> TcRn ()
add_warn reason msg extra_info
= do { loc <- getSrcSpanM
; add_warn_at reason loc msg extra_info }
-- | Display a warning, with an optional flag, for a given location.
-add_warn_at :: WarnReason -> SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
+add_warn_at :: WarnReason -> SrcSpan -> SDoc -> SDoc -> TcRn ()
add_warn_at reason loc msg extra_info
= do { printer <- getPrintUnqualified ;
let { warn = mkLongWarnMsg loc printer
@@ -1521,7 +1521,7 @@ add_warn_at reason loc msg extra_info
Other helper functions
-}
-add_err_tcm :: TidyEnv -> MsgDoc -> SrcSpan
+add_err_tcm :: TidyEnv -> SDoc -> SrcSpan
-> [ErrCtxt]
-> TcM ()
add_err_tcm tidy_env err_msg loc ctxt
@@ -2046,7 +2046,7 @@ getIfModule :: IfL Module
getIfModule = do { env <- getLclEnv; return (if_mod env) }
--------------------
-failIfM :: MsgDoc -> IfL a
+failIfM :: SDoc -> IfL a
-- The Iface monad doesn't have a place to accumulate errors, so we
-- just fall over fast if one happens; it "shouldn't happen".
-- We use IfL here so that we can get context info out of the local env
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 0a0d341a47..8b85ff1a6c 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -230,7 +230,7 @@ import GHC.Data.List.SetOps ( getNth, findDupsEq )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
-import GHC.Utils.Error( Validity(..), MsgDoc, isValid )
+import GHC.Utils.Error( Validity(..), isValid )
import qualified GHC.LanguageExtensions as LangExt
import Data.List ( mapAccumL )
@@ -2432,7 +2432,7 @@ legalFIPrimResultTyCon dflags tc
| otherwise
= NotValid unlifted_only
-unlifted_only :: MsgDoc
+unlifted_only :: SDoc
unlifted_only = text "foreign import prim only accepts simple unlifted types"
validIfUnliftedFFITypes :: DynFlags -> Validity
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index f5cf306dc1..23dcfe6e83 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -159,7 +159,7 @@ matchActualFunTySigma herald mb_thing err_info fun_ty
; return (mkWpCastN co, Scaled mult arg_ty, res_ty) }
------------
- mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
+ mk_ctxt :: TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
mk_ctxt res_ty env = mkFunTysMsg env herald (reverse arg_tys_so_far)
res_ty n_val_args_in_call
(n_val_args_in_call, arg_tys_so_far) = err_info
@@ -371,7 +371,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside
; return (wrap, result) }
------------
- mk_ctxt :: [Scaled ExpSigmaType] -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
+ mk_ctxt :: [Scaled ExpSigmaType] -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
mk_ctxt arg_tys res_ty env
= mkFunTysMsg env herald arg_tys' res_ty arity
where
@@ -380,7 +380,7 @@ matchExpectedFunTys herald ctx arity orig_ty thing_inside
-- this is safe b/c we're called from "go"
mkFunTysMsg :: TidyEnv -> SDoc -> [Scaled TcType] -> TcType -> Arity
- -> TcM (TidyEnv, MsgDoc)
+ -> TcM (TidyEnv, SDoc)
mkFunTysMsg env herald arg_tys res_ty n_val_args_in_call
= do { (env', fun_rho) <- zonkTidyTcType env $
mkVisFunTys arg_tys res_ty
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index f66c768c57..f446b69634 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -2205,7 +2205,7 @@ checkValidAssocTyFamDeflt fam_tc pats =
--
checkFamInstRhs :: TyCon -> [Type] -- LHS
-> [(TyCon, [Type])] -- type family calls in RHS
- -> [MsgDoc]
+ -> [SDoc]
checkFamInstRhs lhs_tc lhs_tys famInsts
= mapMaybe check famInsts
where