Improve error handling in TcRnMonad
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 5 Oct 2016 21:00:02 +0000 (22:00 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 5 Oct 2016 21:00:57 +0000 (22:00 +0100)
See Note [Constraints and errors] in TcRnMonad.  This
patch fixes Trac #12124 in quite a neat way.

compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcSplice.hs
testsuite/tests/typecheck/should_fail/CustomTypeErrors02.stderr
testsuite/tests/typecheck/should_fail/T12124.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T12124.srderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T12124.stderr [new file with mode: 0644]
testsuite/tests/typecheck/should_fail/T8142.stderr
testsuite/tests/typecheck/should_fail/all.T

index a83fbf2..6d949a9 100644 (file)
@@ -69,7 +69,7 @@ module TcRnMonad(
   reportWarning, recoverM, mapAndRecoverM, mapAndReportM,
   tryTc,
   askNoErrs, discardErrs,
-  tryTcErrs, tryTcLIE, tryTcLIE_,
+  tryTcErrs, tryTcLIE_,
   checkNoErrs, whenNoErrs,
   ifErrsM, failIfErrsM,
   checkTH, failTH,
@@ -907,12 +907,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,27 +1002,15 @@ tryTcErrs thing
         }
 
 -----------------------
-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
         }
 
@@ -1032,7 +1023,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
@@ -1074,7 +1065,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
index ed55323..552426b 100644 (file)
@@ -879,7 +879,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
index 0b8be13..3d551ac 100644 (file)
@@ -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
diff --git a/testsuite/tests/typecheck/should_fail/T12124.hs b/testsuite/tests/typecheck/should_fail/T12124.hs
new file mode 100644 (file)
index 0000000..59d29c5
--- /dev/null
@@ -0,0 +1,8 @@
+module T12124 where
+
+data Whoops = Whoops Int Int
+
+foo :: Maybe Int
+foo = return (case Whoops 1 2 of
+                 Whoops a -> a
+                 _ -> 0)
diff --git a/testsuite/tests/typecheck/should_fail/T12124.srderr b/testsuite/tests/typecheck/should_fail/T12124.srderr
new file mode 100644 (file)
index 0000000..0519ecb
--- /dev/null
@@ -0,0 +1 @@
\ No newline at end of file
diff --git a/testsuite/tests/typecheck/should_fail/T12124.stderr b/testsuite/tests/typecheck/should_fail/T12124.stderr
new file mode 100644 (file)
index 0000000..cf3c755
--- /dev/null
@@ -0,0 +1,9 @@
+
+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 })’
index 4200268..6916435 100644 (file)
@@ -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 ((,) a)’ with ‘g (Nu ((,) a))’
-      Expected type: Nu ((,) a) -> (a, g (Nu ((,) a)))
-        Actual type: Nu ((,) a) -> (a, Nu ((,) a))
-    • 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 ((,) a) -> Nu g (bound at T8142.hs:6:18)
index c5596d6..e595000 100644 (file)
@@ -430,3 +430,4 @@ test('T7437', normal, compile_fail, [''])
 test('T12177', normal, compile_fail, [''])
 test('T12406', normal, compile_fail, [''])
 test('T12170a', normal, compile_fail, [''])
+test('T12124', normal, compile_fail, [''])