Commit 5662ceae authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ben Gamari

Improve error handling in TcRnMonad

See Note [Constraints and errors] in TcRnMonad.  This
patch fixes Trac #12124 in quite a neat way.

(cherry picked from commit 465c6c5d)
parent bdfa8a1c
......@@ -69,7 +69,7 @@ module TcRnMonad(
reportWarning, recoverM, mapAndRecoverM, mapAndReportM,
tryTc,
askNoErrs, discardErrs,
tryTcErrs, tryTcLIE, tryTcLIE_,
tryTcErrs, tryTcLIE_,
checkNoErrs, whenNoErrs,
ifErrsM, failIfErrsM,
checkTH, failTH,
......@@ -908,12 +908,15 @@ reportWarning reason err
try_m :: TcRn r -> TcRn (Either IOEnvFailure r)
-- Does tryM, with a debug-trace on failure
try_m thing
= do { mb_r <- tryM thing ;
case mb_r of
Left exn -> do { traceTc "tryTc/recoverM recovering from" $
text (showException exn)
; return mb_r }
Right _ -> return mb_r }
= do { mb_r <- tryM (captureConstraints thing)
-- See Note [Constraints and errors] for the
-- captureConstraints/emitContraints dance
; case mb_r of
Left exn -> do { traceTc "tryTc/recoverM recovering from" $
text (showException exn)
; return (Left exn) }
Right (res, lie) -> do { emitConstraints lie
; return (Right res) } }
-----------------------
recoverM :: TcRn r -- Recovery action; do this if the main one fails
......@@ -999,28 +1002,16 @@ tryTcErrs thing
| otherwise -> Just val)
}
-----------------------
tryTcLIE :: TcM a -> TcM (Messages, Maybe a)
-- Just like tryTcErrs, except that it ensures that the LIE
-- for the thing is propagated only if there are no errors
-- Hence it's restricted to the type-check monad
tryTcLIE thing_inside
= do { ((msgs, mb_res), lie) <- captureConstraints (tryTcErrs thing_inside) ;
; case mb_res of
Nothing -> return (msgs, Nothing)
Just val -> do { emitConstraints lie; return (msgs, Just val) }
}
-----------------------
tryTcLIE_ :: TcM r -> TcM r -> TcM r
-- (tryTcLIE_ r m) tries m;
-- if m succeeds with no error messages, it's the answer
-- otherwise tryTcLIE_ drops everything from m and tries r instead.
tryTcLIE_ recover main
= do { (msgs, mb_res) <- tryTcLIE main
= do { (msgs, mb_res) <- tryTcErrs main
; case mb_res of
Just val -> do { addMessages msgs -- There might be warnings
; return val }
; return val }
Nothing -> recover -- Discard all msgs
}
......@@ -1033,7 +1024,7 @@ checkNoErrs :: TcM r -> TcM r
-- If so, it fails too.
-- Regardless, any errors generated by m are propagated to the enclosing context.
checkNoErrs main
= do { (msgs, mb_res) <- tryTcLIE main
= do { (msgs, mb_res) <- tryTcErrs main
; addMessages msgs
; case mb_res of
Nothing -> failM
......@@ -1075,7 +1066,30 @@ failTH e what -- Raise an error in a stage-1 compiler
2 (ppr e)
, text "Perhaps you are using a stage-1 compiler?" ])
{-
{- Note [Constraints and errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this (Trac #12124):
foo :: Maybe Int
foo = return (case Left 3 of
Left -> 1 -- Error here!
_ -> 0)
The call to 'return' will generate a (Monad m) wanted constraint; but
then there'll be "hard error" (i.e. an exception in the TcM monad).
We'll recover in tcPolyBinds, using recoverM. But then the final
tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
un-filled-in, and will emit a misleading error message.
The underlying problem is that an exception interrupts the connstraint
gathering process. Bottom line: if we have an exception, it's best
simply to discard any gathered constraints. Hence in 'try_m' we
capture the constraints in a fresh variable, and only emit them into
the surrounding context if we exit normally. If an exception is
raised, simply discard the collected constraints... we have a hard
error to report. So this capture-the-emit dance isn't as stupid as it
looks :-).
************************************************************************
* *
Context management for the type checker
......
......@@ -878,7 +878,7 @@ instance TH.Quasi TcM where
-- For qRecover, discard error messages if
-- the recovery action is chosen. Otherwise
-- we'll only fail higher up. c.f. tryTcLIE_
-- we'll only fail higher up.
qRecover recover main = do { (msgs, mb_res) <- tryTcErrs main
; case mb_res of
Just val -> do { addMessages msgs -- There might be warnings
......
......@@ -3,8 +3,3 @@ CustomTypeErrors02.hs:17:1: error:
• The type 'a0 -> a0' cannot be represented as an integer.
• When checking the inferred type
err :: (TypeError ...)
CustomTypeErrors02.hs:17:7: error:
• The type 'a0 -> a0' cannot be represented as an integer.
• In the expression: convert id
In an equation for ‘err’: err = convert id
module T12124 where
data Whoops = Whoops Int Int
foo :: Maybe Int
foo = return (case Whoops 1 2 of
Whoops a -> a
_ -> 0)
T12124.hs:7:18: error:
• The constructor ‘Whoops’ should have 2 arguments, but has been given 1
• In the pattern: Whoops a
In a case alternative: Whoops a -> a
In the first argument of ‘return’, namely
‘(case Whoops 1 2 of {
Whoops a -> a
_ -> 0 })’
......@@ -14,13 +14,3 @@ T8142.hs:6:18: error:
= h
where
h = (\ (_, b) -> ((outI . fmap h) b)) . out
T8142.hs:6:57: error:
• Couldn't match type ‘Nu ((,) t)’ with ‘g (Nu ((,) t))’
Expected type: Nu ((,) t) -> (t, g (Nu ((,) t)))
Actual type: Nu ((,) t) -> (t, Nu ((,) t))
• In the second argument of ‘(.)’, namely ‘out’
In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out
• Relevant bindings include
h :: Nu ((,) t) -> Nu g (bound at T8142.hs:6:18)
......@@ -424,3 +424,4 @@ test('T12177', normal, compile_fail, [''])
test('T12170a', normal, compile_fail, [''])
test('T11990a', normal, compile_fail, [''])
test('T11990b', normal, compile_fail, [''])
test('T12124', normal, compile_fail, [''])
Markdown is supported
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