diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-02-04 17:38:08 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-26 19:00:07 -0400 |
commit | d930fecb6d241c1eb13c30cf1126132766ff602e (patch) | |
tree | 6310749b25fe2a53f6e1c389b67f28f6b6e295f4 /compiler/GHC/Tc/Utils/Monad.hs | |
parent | 0d5d344d45c200a5e731e7d067598acd2a4f7050 (diff) | |
download | haskell-d930fecb6d241c1eb13c30cf1126132766ff602e.tar.gz |
Refactor interface loading
In order to support several home-units and several independent
unit-databases, it's easier to explicitly pass UnitState, DynFlags, etc.
to interface loading functions.
This patch converts some functions using monads such as IfG or TcRnIf
with implicit access to HscEnv to use IO instead and to pass them
specific fields of HscEnv instead of an HscEnv value.
Diffstat (limited to 'compiler/GHC/Tc/Utils/Monad.hs')
-rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 22 |
1 files changed, 7 insertions, 15 deletions
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index b79200c288..a3d5b15c98 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -28,7 +28,7 @@ module GHC.Tc.Utils.Monad( whenDOptM, whenGOptM, whenWOptM, whenXOptM, unlessXOptM, getGhcMode, - withDynamicNow, withoutDynamicNow, + withoutDynamicNow, getEpsVar, getEps, updateEps, updateEps_, @@ -49,7 +49,7 @@ module GHC.Tc.Utils.Monad( dumpTcRn, getPrintUnqualified, printForUserTcRn, - traceIf, traceHiDiffs, traceOptIf, + traceIf, traceOptIf, debugTc, -- * Typechecker global environment @@ -551,11 +551,6 @@ unlessXOptM flag thing_inside = do b <- xoptM flag getGhcMode :: TcRnIf gbl lcl GhcMode getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } -withDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a -withDynamicNow = - updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) -> - top { hsc_dflags = setDynamicNow dflags }) - withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a withoutDynamicNow = updTopEnv (\top@(HscEnv { hsc_dflags = dflags }) -> @@ -596,10 +591,9 @@ getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env) -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing -- an exception if it is an error. -withException :: TcRnIf gbl lcl (MaybeErr SDoc a) -> TcRnIf gbl lcl a -withException do_this = do +withException :: MonadIO m => DynFlags -> m (MaybeErr SDoc a) -> m a +withException dflags do_this = do r <- do_this - dflags <- getDynFlags case r of Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err)) Succeeded result -> return result @@ -813,16 +807,14 @@ printForUserTcRn doc = do liftIO (printOutputForUser logger dflags printer doc) {- -traceIf and traceHiDiffs work in the TcRnIf monad, where no RdrEnv is +traceIf works in the TcRnIf monad, where no RdrEnv is available. Alas, they behave inconsistently with the other stuff; e.g. are unaffected by -dump-to-file. -} -traceIf, traceHiDiffs :: SDoc -> TcRnIf m n () -traceIf = traceOptIf Opt_D_dump_if_trace -traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs +traceIf :: SDoc -> TcRnIf m n () +traceIf = traceOptIf Opt_D_dump_if_trace {-# INLINE traceIf #-} -{-# INLINE traceHiDiffs #-} -- see Note [INLINE conditional tracing utilities] traceOptIf :: DumpFlag -> SDoc -> TcRnIf m n () |