diff options
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Utils/Backpack.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 7 |
2 files changed, 8 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index d433a46aed..9c1d3a3991 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -21,6 +21,7 @@ import GHC.Prelude import GHC.Driver.Env import GHC.Driver.Ppr +import GHC.Driver.Session import GHC.Types.Basic (TypeOrKind(..)) import GHC.Types.Fixity (defaultFixity) @@ -283,11 +284,12 @@ findExtraSigImports' :: HscEnv findExtraSigImports' hsc_env HsigFile modname = fmap unionManyUniqDSets (forM reqs $ \(Module iuid mod_name) -> (initIfaceLoad hsc_env - . withException dflags + . withException ctx $ moduleFreeHolesPrecise (text "findExtraSigImports") (mkModule (VirtUnit iuid) mod_name))) where dflags = hsc_dflags hsc_env + ctx = initSDocContext dflags defaultUserStyle unit_state = hsc_units hsc_env reqs = requirementMerges unit_state modname @@ -598,8 +600,9 @@ mergeSignatures ireq_ifaces0 <- liftIO $ forM reqs $ \(Module iuid mod_name) -> do let m = mkModule (VirtUnit iuid) mod_name im = fst (getModuleInstantiation m) + ctx = initSDocContext dflags defaultUserStyle fmap fst - . withException dflags + . withException ctx $ findAndReadIface logger nc fc hooks unit_state home_unit dflags (text "mergeSignatures") im m NotBoot diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index dea37f4919..0572ab00db 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -174,7 +174,6 @@ import GHC.Core.InstEnv import GHC.Core.FamInstEnv import GHC.Driver.Env -import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Runtime.Context @@ -600,11 +599,11 @@ getEpsAndHpt = do { env <- getTopEnv; eps <- liftIO $ hscEPS env -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing -- an exception if it is an error. -withException :: MonadIO m => DynFlags -> m (MaybeErr SDoc a) -> m a -withException dflags do_this = do +withException :: MonadIO m => SDocContext -> m (MaybeErr SDoc a) -> m a +withException ctx do_this = do r <- do_this case r of - Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err)) + Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (renderWithContext ctx err)) Succeeded result -> return result {- |