import Outputable
import UniqSupply
import Unique
-import UniqFM
+import LazyUniqFM
import DynFlags
import StaticFlags
import FastString
import System.IO
import Data.IORef
import Control.Exception
+import Control.Monad
\end{code}
%************************************************************************
\begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = ioToIOEnv
-\end{code}
-
-\begin{code}
initTc :: HscEnv
-> HscSource
unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
-ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -- Do it flag is true
+-- | Do it flag is true
+ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
ifOptM flag thing_inside = do { b <- doptM flag;
if b then thing_inside else return () }
traceOptIf :: DynFlag -> SDoc -> TcRnIf m n () -- No RdrEnv available, so qualify everything
traceOptIf flag doc = ifOptM flag $
- ioToIOEnv (printForUser stderr alwaysQualify doc)
+ liftIO (printForUser stderr alwaysQualify doc)
traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
traceOptTcRn flag doc = ifOptM flag $ do
dumpTcRn :: SDoc -> TcRn ()
dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ;
- ioToTcRn (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+ liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
getGlobalRdrEnv :: TcRn GlobalRdrEnv
getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
+getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
+getRdrEnvs = do { (gbl,lcl) <- getEnvs; return (tcg_rdr_env gbl, tcl_rdr lcl) }
+
getImports :: TcRn ImportAvails
getImports = do { env <- getGblEnv; return (tcg_imports env) }
writeMutVar errs_var (warns, errs `snocBag` err) }
addErrs :: [(SrcSpan,Message)] -> TcRn ()
-addErrs msgs = mappM_ add msgs
+addErrs msgs = mapM_ add msgs
where
add (loc,msg) = addErrAt loc msg
checkErr :: Bool -> Message -> TcRn ()
-- Add the error if the bool is False
-checkErr ok msg = checkM ok (addErr msg)
+checkErr ok msg = unless ok (addErr msg)
warnIf :: Bool -> Message -> TcRn ()
warnIf True msg = addWarn msg
= do { mb_res <- try_m thing ;
case mb_res of
Left exn -> recover
- Right res -> returnM res }
+ Right res -> return res }
-----------------------
= do { (msgs, mb_res) <- tryTcLIE main
; addMessages msgs
; case mb_res of
- Nothing -> failM
+ Nothing -> failM
Just val -> return val
}
setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt })
addErrCtxt :: Message -> TcM a -> TcM a
-addErrCtxt msg = addErrCtxtM (\env -> returnM (env, msg))
+addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))
addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, Message)) -> TcM a -> TcM a
addErrCtxtM msg = updCtxt (\ msgs -> msg : msgs)
; addErrTcM (env0, err_msg) }
addErrsTc :: [Message] -> TcM ()
-addErrsTc err_msgs = mappM_ addErrTc err_msgs
+addErrsTc err_msgs = mapM_ addErrTc err_msgs
addErrTcM :: (TidyEnv, Message) -> TcM ()
addErrTcM (tidy_env, err_msg)
= addErrTcM local_and_msg >> failM
checkTc :: Bool -> Message -> TcM () -- Check that the boolean is true
-checkTc True err = returnM ()
+checkTc True err = return ()
checkTc False err = failWithTc err
\end{code}
extendLIEs :: [Inst] -> TcM ()
extendLIEs []
- = returnM ()
+ = return ()
extendLIEs insts
= do { lie_var <- getLIEVar ;
lie <- readMutVar lie_var ;
failIfM msg
= do { env <- getLclEnv
; let full_msg = (if_loc env <> colon) $$ nest 2 msg
- ; ioToIOEnv (printErrs (full_msg defaultErrStyle))
+ ; liftIO (printErrs (full_msg defaultErrStyle))
; failM }
--------------------
; return Nothing }
}}
where
- print_errs sdoc = ioToIOEnv (printErrs (sdoc defaultErrStyle))
+ print_errs sdoc = liftIO (printErrs (sdoc defaultErrStyle))
forkM :: SDoc -> IfL a -> IfL a
forkM doc thing_inside