Commit 80ef1f06 authored by twanvl's avatar twanvl

Replace ioToTcRn with liftIO

parent 2b670fe3
...@@ -172,7 +172,7 @@ deleteFromLinkEnv to_remove ...@@ -172,7 +172,7 @@ deleteFromLinkEnv to_remove
dataConInfoPtrToName :: Ptr () -> TcM (Either String Name) dataConInfoPtrToName :: Ptr () -> TcM (Either String Name)
dataConInfoPtrToName x = do dataConInfoPtrToName x = do
theString <- ioToTcRn $ do theString <- liftIO $ do
let ptr = castPtr x :: Ptr StgInfoTable let ptr = castPtr x :: Ptr StgInfoTable
conDescAddress <- getConDescAddress ptr conDescAddress <- getConDescAddress ptr
peekArray0 0 conDescAddress peekArray0 0 conDescAddress
......
...@@ -50,8 +50,7 @@ import Linker ...@@ -50,8 +50,7 @@ import Linker
import DataCon import DataCon
import Type import Type
import Var import Var
import TcRnMonad ( TcM, initTc, ioToTcRn, import TcRnMonad
tryTcErrs, traceTc)
import TcType import TcType
import TcMType import TcMType
import TcUnify import TcUnify
...@@ -538,7 +537,7 @@ traceTR :: SDoc -> TR () ...@@ -538,7 +537,7 @@ traceTR :: SDoc -> TR ()
traceTR = liftTcM . traceTc traceTR = liftTcM . traceTc
trIO :: IO a -> TR a trIO :: IO a -> TR a
trIO = liftTcM . ioToTcRn trIO = liftTcM . liftIO
liftTcM :: TcM a -> TR a liftTcM :: TcM a -> TR a
liftTcM = id liftTcM = id
......
...@@ -1303,9 +1303,9 @@ printMinimalImports imps ...@@ -1303,9 +1303,9 @@ printMinimalImports imps
this_mod <- getModule ; this_mod <- getModule ;
rdr_env <- getGlobalRdrEnv ; rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ; dflags <- getDOpts ;
ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ; liftIO $ do h <- openFile (mkFilename this_mod) WriteMode
printForUser h (mkPrintUnqualified dflags rdr_env) printForUser h (mkPrintUnqualified dflags rdr_env)
(vcat (map ppr_mod_ie mod_ies)) }) (vcat (map ppr_mod_ie mod_ies))
} }
where where
mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports" mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
......
...@@ -521,7 +521,7 @@ mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth ...@@ -521,7 +521,7 @@ mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth
(badGenericInstance sel_id (notGeneric tycon)) (badGenericInstance sel_id (notGeneric tycon))
; dflags <- getDOpts ; dflags <- getDOpts
; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body" ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
(vcat [ppr clas <+> ppr inst_tys, (vcat [ppr clas <+> ppr inst_tys,
nest 2 (ppr sel_id <+> equals <+> ppr rhs)])) nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
...@@ -602,8 +602,8 @@ getGenericInstances class_decls ...@@ -602,8 +602,8 @@ getGenericInstances class_decls
-- Otherwise print it out -- Otherwise print it out
{ dflags <- getDOpts { dflags <- getDOpts
; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances" ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances"
(vcat (map pprInstInfoDetails gen_inst_info))) (vcat (map pprInstInfoDetails gen_inst_info)))
; return gen_inst_info }} ; return gen_inst_info }}
get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods}) get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
......
...@@ -286,8 +286,8 @@ tcDeriving tycl_decls inst_decls deriv_decls ...@@ -286,8 +286,8 @@ tcDeriving tycl_decls inst_decls deriv_decls
; let inst_info = insts1 ++ insts2 ; let inst_info = insts1 ++ insts2
; dflags <- getDOpts ; dflags <- getDOpts
; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
(ddump_deriving inst_info rn_binds)) (ddump_deriving inst_info rn_binds))
; return (inst_info, rn_binds) } ; return (inst_info, rn_binds) }
where where
......
...@@ -64,11 +64,6 @@ import Control.Monad ...@@ -64,11 +64,6 @@ import Control.Monad
%* * %* *
%************************************************************************ %************************************************************************
\begin{code}
ioToTcRn :: IO r -> TcRn r
ioToTcRn = liftIO
\end{code}
\begin{code} \begin{code}
initTc :: HscEnv initTc :: HscEnv
...@@ -373,7 +368,7 @@ traceOptTcRn flag doc = ifOptM flag $ do ...@@ -373,7 +368,7 @@ traceOptTcRn flag doc = ifOptM flag $ do
dumpTcRn :: SDoc -> TcRn () dumpTcRn :: SDoc -> TcRn ()
dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ; dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ; dflags <- getDOpts ;
ioToTcRn (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) } liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
dumpOptTcRn :: DynFlag -> SDoc -> TcRn () dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc) dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
......
...@@ -567,7 +567,7 @@ runMeta convert expr ...@@ -567,7 +567,7 @@ runMeta convert expr
-- Compile and link it; might fail if linking fails -- Compile and link it; might fail if linking fails
; hsc_env <- getTopEnv ; hsc_env <- getTopEnv
; src_span <- getSrcSpanM ; src_span <- getSrcSpanM
; either_hval <- tryM $ ioToTcRn $ ; either_hval <- tryM $ liftIO $
HscMain.compileExpr hsc_env src_span ds_expr HscMain.compileExpr hsc_env src_span ds_expr
; case either_hval of { ; case either_hval of {
Left exn -> failWithTc (mk_msg "compile and link" exn) ; Left exn -> failWithTc (mk_msg "compile and link" exn) ;
...@@ -668,7 +668,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where ...@@ -668,7 +668,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
Nothing -> recover -- Discard all msgs Nothing -> recover -- Discard all msgs
} }
qRunIO io = ioToTcRn io qRunIO io = liftIO io
\end{code} \end{code}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment