X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=64b40f60b2592e4f21a02c5de8b7c102167bcce6;hp=56f073fdc15885df48a6fec07c5e35fa13d46b20;hb=940524aec90652b5ef81789c9a453c57c0e42cc9;hpb=ec0b859902e717c24addff49f9a83efb927fb669 diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 56f073f..64b40f6 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -14,14 +14,6 @@ module TcRnMonad( import TcRnTypes -- Re-export all import IOEnv -- Re-export all -#if defined(GHCI) -import TypeRep -import IdInfo -import TysWiredIn -import PrelNames -import {-#SOURCE#-} TcEnv -#endif - import HsSyn hiding (LIE) import HscTypes import Module @@ -332,7 +324,7 @@ newUniqueSupply newLocalName :: Name -> TcRnIf gbl lcl Name newLocalName name -- Make a clone = do { uniq <- newUnique - ; return (mkInternalName uniq (nameOccName name) (getSrcLoc name)) } + ; return (mkInternalName uniq (nameOccName name) (getSrcSpan name)) } newSysLocalIds :: FastString -> [TcType] -> TcRnIf gbl lcl [TcId] newSysLocalIds fs tys @@ -733,11 +725,14 @@ checkTc False err = failWithTc err \begin{code} addWarnTc :: Message -> TcM () -addWarnTc msg +addWarnTc msg = do { env0 <- tcInitTidyEnv + ; addWarnTcM (env0, msg) } + +addWarnTcM :: (TidyEnv, Message) -> TcM () +addWarnTcM (env0, msg) = do { ctxt <- getErrCtxt ; - env0 <- tcInitTidyEnv ; ctxt_msgs <- do_ctxt env0 ctxt ; - addWarn (vcat (msg : ctxt_to_use ctxt_msgs)) } + addReport (vcat (ptext SLIT("Warning:") <+> msg : ctxt_to_use ctxt_msgs)) } warnTc :: Bool -> Message -> TcM () warnTc warn_if_true warn_msg