diff options
| author | sheaf <sam.derbyshire@gmail.com> | 2021-08-23 17:09:19 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-23 23:39:15 -0400 |
| commit | 8a939b404e26bcaa07caa8b5e83bdf79307d2807 (patch) | |
| tree | a69b41ec6e015cddf78a2c9bf65248abc3fb92f5 /compiler/GHC/Tc/Solver/Interact.hs | |
| parent | d94e7ebd9aee5016e68da09883a0a898c4805429 (diff) | |
| download | haskell-8a939b404e26bcaa07caa8b5e83bdf79307d2807.tar.gz | |
TcPlugins: solve and report contras simultaneously
This changes the TcPlugin datatype to allow type-checking plugins
to report insoluble constraints while at the same time solve
some other constraints. This allows better error messages, as
the plugin can still simplify constraints, even when it wishes
to report a contradiction.
Pattern synonyms TcPluginContradiction and TcPluginOk are provided
for backwards compatibility: existing type-checking plugins should
continue to work without modification.
Diffstat (limited to 'compiler/GHC/Tc/Solver/Interact.hs')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Interact.hs | 19 |
1 files changed, 11 insertions, 8 deletions
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs index 98824022cd..72f4a509c4 100644 --- a/compiler/GHC/Tc/Solver/Interact.hs +++ b/compiler/GHC/Tc/Solver/Interact.hs @@ -287,15 +287,18 @@ runTcPluginSolvers solvers all_cts return $ progress p result progress :: TcPluginProgress -> TcPluginSolveResult -> TcPluginProgress - progress p (TcPluginContradiction bad_cts) = - p { pluginInputCts = discard bad_cts (pluginInputCts p) - , pluginBadCts = bad_cts ++ pluginBadCts p - } - progress p (TcPluginOk solved_cts new_cts) = - p { pluginInputCts = discard (map snd solved_cts) (pluginInputCts p) - , pluginSolvedCts = add solved_cts (pluginSolvedCts p) - , pluginNewCts = new_cts ++ pluginNewCts p + progress p + (TcPluginSolveResult + { tcPluginInsolubleCts = bad_cts + , tcPluginSolvedCts = solved_cts + , tcPluginNewCts = new_cts } + ) = + p { pluginInputCts = discard (bad_cts ++ map snd solved_cts) (pluginInputCts p) + , pluginSolvedCts = add solved_cts (pluginSolvedCts p) + , pluginNewCts = new_cts ++ pluginNewCts p + , pluginBadCts = bad_cts ++ pluginBadCts p + } initialProgress = TcPluginProgress all_cts ([], [], []) [] [] |