projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove gaw comment
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcRnMonad.lhs
diff --git
a/compiler/typecheck/TcRnMonad.lhs
b/compiler/typecheck/TcRnMonad.lhs
index
ed1dce6
..
3c6c59e
100644
(file)
--- a/
compiler/typecheck/TcRnMonad.lhs
+++ b/
compiler/typecheck/TcRnMonad.lhs
@@
-44,7
+44,7
@@
import Bag
import Outputable
import UniqSupply
import Unique
import Outputable
import UniqSupply
import Unique
-import UniqFM
+import LazyUniqFM
import DynFlags
import StaticFlags
import FastString
import DynFlags
import StaticFlags
import FastString
@@
-53,6
+53,7
@@
import Panic
import System.IO
import Data.IORef
import Control.Exception
import System.IO
import Data.IORef
import Control.Exception
+import Control.Monad
\end{code}
\end{code}
@@
-64,11
+65,6
@@
import Control.Exception
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = ioToIOEnv
-\end{code}
-
-\begin{code}
initTc :: HscEnv
-> HscSource
initTc :: HscEnv
-> HscSource
@@
-247,7
+243,8
@@
unsetOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
unsetOptM flag = updEnv (\ env@(Env { env_top = top }) ->
env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} )
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 () }
ifOptM flag thing_inside = do { b <- doptM flag;
if b then thing_inside else return () }
@@
-357,7
+354,7
@@
traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
traceOptIf :: DynFlag -> SDoc -> TcRnIf m n () -- No RdrEnv available, so qualify everything
traceOptIf flag doc = ifOptM flag $
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
traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
traceOptTcRn flag doc = ifOptM flag $ do
@@
-371,7
+368,7
@@
traceOptTcRn flag doc = ifOptM flag $ do
dumpTcRn :: SDoc -> TcRn ()
dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ;
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)
dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
@@
-486,7
+483,7
@@
addLongErrAt loc msg extra
writeMutVar errs_var (warns, errs `snocBag` err) }
addErrs :: [(SrcSpan,Message)] -> TcRn ()
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
where
add (loc,msg) = addErrAt loc msg
@@
-513,7
+510,7
@@
addLocWarn (L loc e) fn = addReportAt loc (fn e)
checkErr :: Bool -> Message -> TcRn ()
-- Add the error if the bool is False
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
warnIf :: Bool -> Message -> TcRn ()
warnIf True msg = addWarn msg
@@
-562,7
+559,7
@@
recoverM recover thing
= do { mb_res <- try_m thing ;
case mb_res of
Left exn -> recover
= do { mb_res <- try_m thing ;
case mb_res of
Left exn -> recover
- Right res -> returnM res }
+ Right res -> return res }
-----------------------
-----------------------
@@
-649,7
+646,7
@@
checkNoErrs main
= do { (msgs, mb_res) <- tryTcLIE main
; addMessages msgs
; case mb_res of
= do { (msgs, mb_res) <- tryTcLIE main
; addMessages msgs
; case mb_res of
- Nothing -> failM
+ Nothing -> failM
Just val -> return val
}
Just val -> return val
}
@@
-687,7
+684,7
@@
setErrCtxt :: ErrCtxt -> TcM a -> TcM a
setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt })
addErrCtxt :: Message -> TcM a -> TcM a
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)
addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, Message)) -> TcM a -> TcM a
addErrCtxtM msg = updCtxt (\ msgs -> msg : msgs)
@@
-727,7
+724,7
@@
addErrTc err_msg = do { env0 <- tcInitTidyEnv
; addErrTcM (env0, err_msg) }
addErrsTc :: [Message] -> TcM ()
; 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 :: (TidyEnv, Message) -> TcM ()
addErrTcM (tidy_env, err_msg)
@@
-748,7
+745,7
@@
failWithTcM local_and_msg
= addErrTcM local_and_msg >> failM
checkTc :: Bool -> Message -> TcM () -- Check that the boolean is true
= 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}
checkTc False err = failWithTc err
\end{code}
@@
-862,7
+859,7
@@
extendLIE inst
extendLIEs :: [Inst] -> TcM ()
extendLIEs []
extendLIEs :: [Inst] -> TcM ()
extendLIEs []
- = returnM ()
+ = return ()
extendLIEs insts
= do { lie_var <- getLIEVar ;
lie <- readMutVar lie_var ;
extendLIEs insts
= do { lie_var <- getLIEVar ;
lie <- readMutVar lie_var ;
@@
-1007,7
+1004,7
@@
failIfM :: Message -> IfL a
failIfM msg
= do { env <- getLclEnv
; let full_msg = (if_loc env <> colon) $$ nest 2 msg
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 }
--------------------
; failM }
--------------------
@@
-1042,7
+1039,7
@@
forkM_maybe doc thing_inside
; return Nothing }
}}
where
; 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
forkM :: SDoc -> IfL a -> IfL a
forkM doc thing_inside