Commit 1ef27429 authored by Simon Peyton Jones's avatar Simon Peyton Jones Committed by Ben Gamari

Further improve error handling in TcRn monad

This patch builds on the one for Trac #12124, by dealing properly
with out-of-scope "hole" errors.

This fixes Trac #12529. The hard error coming from visible type application
is still there, but the out-of-scope error is no longer suppressed.

(Arguably the VTA message should be suppressed somehow, but that's a
battle for another day.)

(cherry picked from commit 2fdf21bf)
parent 243994c3
......@@ -913,7 +913,7 @@ try_m thing
-- captureConstraints/emitContraints dance
; case mb_r of
Left exn -> do { traceTc "tryTc/recoverM recovering from" $
text (showException exn)
text (showException exn)
; return (Left exn) }
Right (res, lie) -> do { emitConstraints lie
; return (Right res) } }
......@@ -1081,7 +1081,7 @@ 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
The underlying problem is that an exception interrupts the constraint
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
......@@ -1090,6 +1090,18 @@ 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 :-).
However suppose we throw an exception inside an invocation of
captureConstraints. Then we'll discard all the costraints. But some
of those contraints might be "variable out of scope" Hole constraints,
and that might have been the actual original cause of the exception!
For example (Trac #12529):
f = p @ Int
Here 'p' is out of scope, so we get an insolube Hole constraint. But
the visible type application fails in the monad (thows an exception).
We must not discard the out-of-scope error. Hence the use of tryM in
captureConstraints to propagate insoluble constraints.
************************************************************************
* *
Context management for the type checker
......@@ -1389,10 +1401,16 @@ emitImplications ct
emitInsoluble :: Ct -> TcM ()
emitInsoluble ct
= do { lie_var <- getConstraintVar ;
updTcRef lie_var (`addInsols` unitBag ct) ;
v <- readTcRef lie_var ;
traceTc "emitInsoluble" (ppr v) }
= do { traceTc "emitInsoluble" (ppr ct)
; lie_var <- getConstraintVar
; updTcRef lie_var (`addInsols` unitBag ct) }
emitInsolubles :: Cts -> TcM ()
emitInsolubles cts
| isEmptyBag cts = return ()
| otherwise = do { traceTc "emitInsolubles" (ppr cts)
; lie_var <- getConstraintVar
; updTcRef lie_var (`addInsols` cts) }
-- | Throw out any constraints emitted by the thing_inside
discardConstraints :: TcM a -> TcM a
......@@ -1401,21 +1419,26 @@ discardConstraints thing_inside = fst <$> captureConstraints thing_inside
captureConstraints :: TcM a -> TcM (a, WantedConstraints)
-- (captureConstraints m) runs m, and returns the type constraints it generates
captureConstraints thing_inside
= do { lie_var <- newTcRef emptyWC ;
res <- updLclEnv (\ env -> env { tcl_lie = lie_var })
thing_inside ;
lie <- readTcRef lie_var ;
return (res, lie) }
= do { lie_var <- newTcRef emptyWC
; mb_res <- tryM $
updLclEnv (\ env -> env { tcl_lie = lie_var }) $
thing_inside
; lie <- readTcRef lie_var
-- See Note [Constraints and errors] for the
-- tryM/failM dance here
; case mb_res of
Left _ -> do { emitInsolubles (getInsolubles lie)
; failM }
Right res -> return (res, lie) }
pushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a)
pushLevelAndCaptureConstraints thing_inside
= do { env <- getLclEnv
; lie_var <- newTcRef emptyWC
; let tclvl' = pushTcLevel (tcl_tclvl env)
; res <- setLclEnv (env { tcl_tclvl = tclvl'
, tcl_lie = lie_var })
thing_inside
; lie <- readTcRef lie_var
; (res, lie) <- setLclEnv (env { tcl_tclvl = tclvl' }) $
captureConstraints thing_inside
; return (tclvl', lie, res) }
pushTcLevelM_ :: TcM a -> TcM a
......@@ -1458,24 +1481,28 @@ traceTcConstraints :: String -> TcM ()
traceTcConstraints msg
= do { lie_var <- getConstraintVar
; lie <- readTcRef lie_var
; traceTc (msg ++ ": LIE:") (ppr lie)
; traceOptTcRn Opt_D_dump_tc_trace $
hang (text (msg ++ ": LIE:")) 2 (ppr lie)
}
emitWildCardHoleConstraints :: [(Name, TcTyVar)] -> TcM ()
emitWildCardHoleConstraints wcs
= do { ctLoc <- getCtLocM HoleOrigin Nothing
; forM_ wcs $ \(name, tv) -> do {
; let real_span = case nameSrcSpan name of
= do { ct_loc <- getCtLocM HoleOrigin Nothing
; emitInsolubles $ listToBag $
map (do_one ct_loc) wcs }
where
do_one :: CtLoc -> (Name, TcTyVar) -> Ct
do_one ct_loc (name, tv)
= CHoleCan { cc_ev = CtDerived { ctev_pred = mkTyVarTy tv
, ctev_loc = ct_loc' }
, cc_hole = TypeHole (occName name) }
where
real_span = case nameSrcSpan name of
RealSrcSpan span -> span
UnhelpfulSpan str -> pprPanic "emitWildCardHoleConstraints"
(ppr name <+> quotes (ftext str))
-- Wildcards are defined locally, and so have RealSrcSpans
ctLoc' = setCtLocSpan ctLoc real_span
ty = mkTyVarTy tv
can = CHoleCan { cc_ev = CtDerived { ctev_pred = ty
, ctev_loc = ctLoc' }
, cc_hole = TypeHole (occName name) }
; emitInsoluble can } }
ct_loc' = setCtLocSpan ct_loc real_span
{-
************************************************************************
......
......@@ -83,7 +83,7 @@ module TcRnTypes(
WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
toDerivedWC,
andWC, unionsWC, mkSimpleWC, mkImplicWC,
addInsols, addSimples, addImplics,
addInsols, getInsolubles, addSimples, addImplics,
tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples, dropDerivedInsols,
tyCoVarsOfWCList,
isDroppableDerivedLoc, insolubleImplic,
......@@ -2045,6 +2045,9 @@ addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints
addInsols wc cts
= wc { wc_insol = wc_insol wc `unionBags` cts }
getInsolubles :: WantedConstraints -> Cts
getInsolubles = wc_insol
dropDerivedWC :: WantedConstraints -> WantedConstraints
-- See Note [Dropping derived constraints]
dropDerivedWC wc@(WC { wc_simple = simples, wc_insol = insols })
......
{-# LANGUAGE TypeApplications #-}
module T12529 where
f = p @ Int
T12529.hs:5:5: error: Variable not in scope: p
T12529.hs:5:5: error:
• Cannot apply expression of type ‘t1’
to a visible type argument ‘Int’
• In the expression: p @Int
In an equation for ‘f’: f = p @Int
......@@ -425,3 +425,5 @@ test('T12170a', normal, compile_fail, [''])
test('T11990a', normal, compile_fail, [''])
test('T11990b', normal, compile_fail, [''])
test('T12124', normal, compile_fail, [''])
test('T12529', 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