From 80ef1f06253f1a20a63816c295e180e47cd9a347 Mon Sep 17 00:00:00 2001 From: Twan van Laarhoven Date: Thu, 17 Jan 2008 22:05:53 +0000 Subject: [PATCH] Replace ioToTcRn with liftIO --- compiler/ghci/Linker.lhs | 2 +- compiler/ghci/RtClosureInspect.hs | 5 ++--- compiler/rename/RnNames.lhs | 6 +++--- compiler/typecheck/TcClassDcl.lhs | 6 +++--- compiler/typecheck/TcDeriv.lhs | 4 ++-- compiler/typecheck/TcRnMonad.lhs | 7 +------ compiler/typecheck/TcSplice.lhs | 4 ++-- 7 files changed, 14 insertions(+), 20 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 5ab7416..eaae5d0 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -172,7 +172,7 @@ deleteFromLinkEnv to_remove dataConInfoPtrToName :: Ptr () -> TcM (Either String Name) dataConInfoPtrToName x = do - theString <- ioToTcRn $ do + theString <- liftIO $ do let ptr = castPtr x :: Ptr StgInfoTable conDescAddress <- getConDescAddress ptr peekArray0 0 conDescAddress diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 437ff94..db8930a 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -50,8 +50,7 @@ import Linker import DataCon import Type import Var -import TcRnMonad ( TcM, initTc, ioToTcRn, - tryTcErrs, traceTc) +import TcRnMonad import TcType import TcMType import TcUnify @@ -538,7 +537,7 @@ traceTR :: SDoc -> TR () traceTR = liftTcM . traceTc trIO :: IO a -> TR a -trIO = liftTcM . ioToTcRn +trIO = liftTcM . liftIO liftTcM :: TcM a -> TR a liftTcM = id diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index feb4d25..ed3efd2 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -1303,9 +1303,9 @@ printMinimalImports imps this_mod <- getModule ; rdr_env <- getGlobalRdrEnv ; dflags <- getDOpts ; - ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ; - printForUser h (mkPrintUnqualified dflags rdr_env) - (vcat (map ppr_mod_ie mod_ies)) }) + liftIO $ do h <- openFile (mkFilename this_mod) WriteMode + printForUser h (mkPrintUnqualified dflags rdr_env) + (vcat (map ppr_mod_ie mod_ies)) } where mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports" diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs index daa03d0..f431cd6 100644 --- a/compiler/typecheck/TcClassDcl.lhs +++ b/compiler/typecheck/TcClassDcl.lhs @@ -521,7 +521,7 @@ mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth (badGenericInstance sel_id (notGeneric tycon)) ; 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, nest 2 (ppr sel_id <+> equals <+> ppr rhs)])) @@ -602,8 +602,8 @@ getGenericInstances class_decls -- Otherwise print it out { dflags <- getDOpts - ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances" - (vcat (map pprInstInfoDetails gen_inst_info))) + ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances" + (vcat (map pprInstInfoDetails gen_inst_info))) ; return gen_inst_info }} get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods}) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index a1f98a9..7422c6f 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -286,8 +286,8 @@ tcDeriving tycl_decls inst_decls deriv_decls ; let inst_info = insts1 ++ insts2 ; dflags <- getDOpts - ; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" - (ddump_deriving inst_info rn_binds)) + ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" + (ddump_deriving inst_info rn_binds)) ; return (inst_info, rn_binds) } where diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index d7988e8..2d74e77 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -65,11 +65,6 @@ import Control.Monad %************************************************************************ \begin{code} -ioToTcRn :: IO r -> TcRn r -ioToTcRn = liftIO -\end{code} - -\begin{code} initTc :: HscEnv -> HscSource @@ -373,7 +368,7 @@ 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) diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 7dc7d94..48cec19 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -567,7 +567,7 @@ runMeta convert expr -- Compile and link it; might fail if linking fails ; hsc_env <- getTopEnv ; src_span <- getSrcSpanM - ; either_hval <- tryM $ ioToTcRn $ + ; either_hval <- tryM $ liftIO $ HscMain.compileExpr hsc_env src_span ds_expr ; case either_hval of { Left exn -> failWithTc (mk_msg "compile and link" exn) ; @@ -668,7 +668,7 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where Nothing -> recover -- Discard all msgs } - qRunIO io = ioToTcRn io + qRunIO io = liftIO io \end{code} -- 1.7.10.4