Commit 51462af9 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Recover after an error in an implication constraint

parent 723365de
...@@ -15,7 +15,7 @@ module TcSMonad ( ...@@ -15,7 +15,7 @@ module TcSMonad (
combineCtLoc, mkGivenFlavor, combineCtLoc, mkGivenFlavor,
TcS, runTcS, failTcS, panicTcS, traceTcS, traceTcS0, -- Basic functionality TcS, runTcS, failTcS, panicTcS, traceTcS, traceTcS0, -- Basic functionality
tryTcS, nestImplicTcS, wrapErrTcS, wrapWarnTcS, tryTcS, nestImplicTcS, recoverTcS, wrapErrTcS, wrapWarnTcS,
SimplContext(..), isInteractive, simplEqsOnly, performDefaulting, SimplContext(..), isInteractive, simplEqsOnly, performDefaulting,
-- Creation of evidence variables -- Creation of evidence variables
...@@ -235,6 +235,8 @@ variable, is not canonical. Why? ...@@ -235,6 +235,8 @@ variable, is not canonical. Why?
Hence the invariant. Hence the invariant.
The invariant is
Note [Canonical implicit parameter constraints] Note [Canonical implicit parameter constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The type in a canonical implicit parameter constraint doesn't need to The type in a canonical implicit parameter constraint doesn't need to
...@@ -491,6 +493,11 @@ nestImplicTcS ref untch (TcS thing_inside) ...@@ -491,6 +493,11 @@ nestImplicTcS ref untch (TcS thing_inside)
in in
thing_inside nest_env thing_inside nest_env
recoverTcS :: TcS a -> TcS a -> TcS a
recoverTcS (TcS recovery_code) (TcS thing_inside)
= TcS $ \ env ->
TcM.recoverM (recovery_code env) (thing_inside env)
ctxtUnderImplic :: SimplContext -> SimplContext ctxtUnderImplic :: SimplContext -> SimplContext
-- See Note [Simplifying RULE lhs constraints] in TcSimplify -- See Note [Simplifying RULE lhs constraints] in TcSimplify
ctxtUnderImplic SimplRuleLhs = SimplCheck ctxtUnderImplic SimplRuleLhs = SimplCheck
......
...@@ -706,6 +706,10 @@ solveImplication inert ...@@ -706,6 +706,10 @@ solveImplication inert
, ic_wanted = wanteds , ic_wanted = wanteds
, ic_loc = loc }) , ic_loc = loc })
= nestImplicTcS ev_binds untch $ = nestImplicTcS ev_binds untch $
recoverTcS (return (emptyBag, emptyBag)) $
-- Recover from nested failures. Even the top level is
-- just a bunch of implications, so failing at the first
-- one is bad
do { traceTcS "solveImplication {" (ppr imp) do { traceTcS "solveImplication {" (ppr imp)
-- Solve flat givens -- Solve flat givens
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment