X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=ad741336daf39317d489239367fb15f726ba4fff;hb=ee2571bd2a80683d33cf65a01942bc8be50a5e33;hp=06185bed4e87218cd83c4a70028757c80f016d08;hpb=530ced58cd18b165d03b6f62ff513c83c4fa4718;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 06185be..ad74133 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -489,26 +489,27 @@ addErrs msgs = mapM_ add msgs where add (loc,msg) = addErrAt loc msg -addReport :: Message -> TcRn () -addReport msg = do loc <- getSrcSpanM; addReportAt loc msg +addReport :: Message -> Message -> TcRn () +addReport msg extra_info = do loc <- getSrcSpanM; addReportAt loc msg extra_info -addReportAt :: SrcSpan -> Message -> TcRn () -addReportAt loc msg +addReportAt :: SrcSpan -> Message -> Message -> TcRn () +addReportAt loc msg extra_info = do { errs_var <- getErrsVar ; rdr_env <- getGlobalRdrEnv ; dflags <- getDOpts ; - let { warn = mkWarnMsg loc (mkPrintUnqualified dflags rdr_env) msg } ; + let { warn = mkLongWarnMsg loc (mkPrintUnqualified dflags rdr_env) + msg extra_info } ; (warns, errs) <- readMutVar errs_var ; writeMutVar errs_var (warns `snocBag` warn, errs) } addWarn :: Message -> TcRn () -addWarn msg = addReport (ptext (sLit "Warning:") <+> msg) +addWarn msg = addReport (ptext (sLit "Warning:") <+> msg) empty addWarnAt :: SrcSpan -> Message -> TcRn () -addWarnAt loc msg = addReportAt loc (ptext (sLit "Warning:") <+> msg) +addWarnAt loc msg = addReportAt loc (ptext (sLit "Warning:") <+> msg) empty addLocWarn :: Located e -> (e -> Message) -> TcRn () -addLocWarn (L loc e) fn = addReportAt loc (fn e) +addLocWarn (L loc e) fn = addReportAt loc (fn e) empty checkErr :: Bool -> Message -> TcRn () -- Add the error if the bool is False @@ -765,7 +766,7 @@ addWarnTcM :: (TidyEnv, Message) -> TcM () addWarnTcM (env0, msg) = do { ctxt <- getErrCtxt ; err_info <- mkErrInfo env0 ctxt ; - addReport (vcat [ptext (sLit "Warning:") <+> msg, err_info]) } + addReport (ptext (sLit "Warning:") <+> msg) err_info } warnTc :: Bool -> Message -> TcM () warnTc warn_if_true warn_msg