diff options
Diffstat (limited to 'compiler/GHC/Tc/Module.hs')
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index e0a4f58d39..bf190f059c 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -3088,19 +3088,24 @@ withTcPlugins hsc_env m = [] -> m -- Common fast case plugins -> do ev_binds_var <- newTcEvBinds - (solvers,stops) <- unzip `fmap` mapM (startPlugin ev_binds_var) plugins - -- This ensures that tcPluginStop is called even if a type + (solvers, rewriters, stops) <- + unzip3 `fmap` mapM (startPlugin ev_binds_var) plugins + let + rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter] + !rewritersUniqFM = sequenceUFMList rewriters + -- The following ensures that tcPluginStop is called even if a type -- error occurs during compilation (Fix of #10078) eitherRes <- tryM $ - updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m - mapM_ (flip runTcPluginM ev_binds_var) stops + updGblEnv (\e -> e { tcg_tc_plugin_solvers = solvers + , tcg_tc_plugin_rewriters = rewritersUniqFM }) m + mapM_ runTcPluginM stops case eitherRes of Left _ -> failM Right res -> return res where - startPlugin ev_binds_var (TcPlugin start solve stop) = - do s <- runTcPluginM start ev_binds_var - return (solve s, stop s) + startPlugin ev_binds_var (TcPlugin start solve rewrite stop) = + do s <- runTcPluginM start + return (solve s ev_binds_var, rewrite s, stop s) getTcPlugins :: HscEnv -> [GHC.Tc.Utils.Monad.TcPlugin] getTcPlugins hsc_env = catMaybes $ mapPlugins hsc_env (\p args -> tcPlugin p args) |