diff options
| author | Pavol Vargovcik <pavol.vargovcik@gmail.com> | 2022-05-12 09:17:39 +0200 |
|---|---|---|
| committer | Pavol Vargovcik <pavol.vargovcik@gmail.com> | 2022-05-13 06:17:52 +0200 |
| commit | c1e86eb18acdc1608756fe90296ae6d45be88020 (patch) | |
| tree | cf8877744328b0dfe441cc793beef5c78f784f30 | |
| parent | dd4541a920adb6ecb46ef95abf9b8302e4b3fb5e (diff) | |
| download | haskell-c1e86eb18acdc1608756fe90296ae6d45be88020.tar.gz | |
fix: pass global ev_binds_var to tcplugin solver
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Solver/Interact.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Types.hs | 5 |
3 files changed, 8 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 9a19461b13..f77c5563f4 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -3115,9 +3115,8 @@ withTcPlugins hsc_env m = case catMaybes $ mapPlugins (hsc_plugins hsc_env) tcPlugin of [] -> m -- Common fast case plugins -> do - ev_binds_var <- newTcEvBinds (solvers, rewriters, stops) <- - unzip3 `fmap` mapM (start_plugin ev_binds_var) plugins + unzip3 `fmap` mapM start_plugin plugins let rewritersUniqFM :: UniqFM TyCon [TcPluginRewriter] !rewritersUniqFM = sequenceUFMList rewriters @@ -3131,9 +3130,9 @@ withTcPlugins hsc_env m = Left _ -> failM Right res -> return res where - start_plugin ev_binds_var (TcPlugin start solve rewrite stop) = + start_plugin (TcPlugin start solve rewrite stop) = do s <- runTcPluginM start - return (solve s ev_binds_var, rewrite s, stop s) + return (solve s, rewrite s, stop s) withDefaultingPlugins :: HscEnv -> TcM a -> TcM a withDefaultingPlugins hsc_env m = diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs index 0a246939c6..ae59935153 100644 --- a/compiler/GHC/Tc/Solver/Interact.hs +++ b/compiler/GHC/Tc/Solver/Interact.hs @@ -272,7 +272,8 @@ runTcPluginSolvers solvers all_cts where do_plugin :: TcPluginProgress -> TcPluginSolver -> TcS TcPluginProgress do_plugin p solver = do - result <- runTcPluginTcS (uncurry solver (pluginInputCts p)) + ev_binds_var <- getTcEvBindsVar + result <- runTcPluginTcS (uncurry (solver ev_binds_var) (pluginInputCts p)) return $ progress p result progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs index d837b629ec..6fa4cf21de 100644 --- a/compiler/GHC/Tc/Types.hs +++ b/compiler/GHC/Tc/Types.hs @@ -1672,7 +1672,8 @@ Constraint Solver Plugins -- and Wanted constraints, and should return a 'TcPluginSolveResult' -- indicating which Wanted constraints it could solve, or whether any are -- insoluble. -type TcPluginSolver = [Ct] -- ^ Givens +type TcPluginSolver = EvBindsVar + -> [Ct] -- ^ Givens -> [Ct] -- ^ Wanteds -> TcPluginM TcPluginSolveResult @@ -1702,7 +1703,7 @@ data TcPlugin = forall s. TcPlugin { tcPluginInit :: TcPluginM s -- ^ Initialize plugin, when entering type-checker. - , tcPluginSolve :: s -> EvBindsVar -> TcPluginSolver + , tcPluginSolve :: s -> TcPluginSolver -- ^ Solve some constraints. -- -- This function will be invoked at two points in the constraint solving |