diff options
Diffstat (limited to 'compiler/GHC/HsToCore/Monad.hs')
| -rw-r--r-- | compiler/GHC/HsToCore/Monad.hs | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs index df4a377e39..a70538788f 100644 --- a/compiler/GHC/HsToCore/Monad.hs +++ b/compiler/GHC/HsToCore/Monad.hs @@ -107,6 +107,7 @@ import GHC.Types.Error import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Error import Data.IORef @@ -278,7 +279,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds ; runDs hsc_env envs thing_inside } -initTcDsForSolver :: TcM a -> DsM (Messages DecoratedSDoc, Maybe a) +initTcDsForSolver :: TcM a -> DsM a -- Spin up a TcM context so that we can run the constraint solver -- Returns any error messages generated by the constraint solver -- and (Just res) if no error happened; Nothing if an error happened @@ -303,10 +304,13 @@ initTcDsForSolver thing_inside DsLclEnv { dsl_loc = loc } = lcl - ; liftIO $ initTc hsc_env HsSrcFile False mod loc $ + ; (msgs, mb_ret) <- liftIO $ initTc hsc_env HsSrcFile False mod loc $ updGblEnv (\tc_gbl -> tc_gbl { tcg_fam_inst_env = fam_inst_env , tcg_rdr_env = rdr_env }) $ - thing_inside } + thing_inside + ; case mb_ret of + Just ret -> pure ret + Nothing -> pprPanic "initTcDsForSolver" (vcat $ pprMsgEnvelopeBagWithLoc (getErrorMessages msgs)) } mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> IORef (Messages DecoratedSDoc) -> IORef CostCentreState -> CompleteMatches |