Improve error messages for recursive superclasses
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 8 Feb 2016 13:31:11 +0000 (13:31 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 8 Feb 2016 15:08:48 +0000 (15:08 +0000)
If we fail to typecheck by blowing the constraint simplifier
iteration limit, we want to see the limit-blowing meessage.
Previously it was being suppressed by the type /error/, which
suppress the iteration-limit /warning/.  Solution: make the
iteration-limit message into an error.

compiler/typecheck/TcSMonad.hs
compiler/typecheck/TcSimplify.hs

index 5f7abdd..edcedf7 100644 (file)
@@ -14,7 +14,7 @@ module TcSMonad (
 
     -- The TcS monad
     TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds,
-    failTcS, warnTcS,
+    failTcS, warnTcS, addErrTcS,
     runTcSEqualities,
     nestTcS, nestImplicTcS,
 
@@ -2322,10 +2322,11 @@ wrapWarnTcS :: TcM a -> TcS a
 -- There's no static check; it's up to the user
 wrapWarnTcS = wrapTcS
 
-failTcS, panicTcS :: SDoc -> TcS a
-warnTcS           :: SDoc -> TcS ()
+failTcS, panicTcS  :: SDoc -> TcS a
+warnTcS, addErrTcS :: SDoc -> TcS ()
 failTcS      = wrapTcS . TcM.failWith
 warnTcS      = wrapTcS . TcM.addWarn
+addErrTcS    = wrapTcS . TcM.addErr
 panicTcS doc = pprPanic "TcCanonical" doc
 
 traceTcS :: String -> SDoc -> TcS ()
index 479893a..379e17f 100644 (file)
@@ -545,8 +545,8 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
                             -- again later. All we want here are the predicates over which to
                             -- quantify.
                             --
-                            -- If any meta-tyvar unifications take place (unlikely), we'll
-                            -- pick that up later.
+                            -- If any meta-tyvar unifications take place (unlikely),
+                            -- we'll pick that up later.
 
                       -- See Note [Promote _and_ default when inferring]
                       ; let def_tyvar tv
@@ -558,9 +558,10 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
                       ; WC { wc_simple = simples }
                            <- setTcLevel rhs_tclvl $
                               runTcSDeriveds       $
-                              solveSimpleWanteds $ mapBag toDerivedCt quant_cand
-                                -- NB: we don't want evidence, so used
-                                -- Derived constraints
+                              solveSimpleWanteds   $
+                              mapBag toDerivedCt quant_cand
+                                -- NB: we don't want evidence,
+                                -- so use Derived constraints
 
                       ; simples <- TcM.zonkSimples simples
 
@@ -961,7 +962,7 @@ This only half-works, but then let-generalisation only half-works.
 -}
 
 simplifyWantedsTcM :: [CtEvidence] -> TcM WantedConstraints
--- Zonk the input constraints, and simplify them
+-- Solve the specified Wanted constraints
 -- Discard the evidence binds
 -- Discards all Derived stuff in result
 -- Postcondition: fully zonked and unflattened constraints
@@ -1018,7 +1019,11 @@ simpl_loop n limit floated_eqs no_new_scs
   = return wc  -- Done!
 
   | n `intGtLimit` limit
-  = do { warnTcS (hang (text "solveWanteds: too many iterations"
+  = do { -- Add an error (not a warning) if we blow the limit,
+         -- Typically if we blow the limit we are going to report some other error
+         -- (an unsolved constraint), and we don't want that error to suppress
+         -- the iteration limit warning!
+         addErrTcS (hang (text "solveWanteds: too many iterations"
                    <+> parens (text "limit =" <+> ppr limit))
                 2 (vcat [ text "Unsolved:" <+> ppr wc
                         , ppUnless (isEmptyBag floated_eqs) $
@@ -1030,7 +1035,12 @@ simpl_loop n limit floated_eqs no_new_scs
        ; return wc }
 
   | otherwise
-  = do { traceTcS "simpl_loop, iteration" (int n)
+  = do { let n_floated = lengthBag floated_eqs
+       ; csTraceTcS $
+         text "simpl_loop iteration=" <> int n
+         <+> (parens $ hsep [ text "no new scs =" <+> ppr no_new_scs <> comma
+                            , int n_floated <+> text "floated eqs" <> comma
+                            , int (lengthBag simples) <+> text "simples to solve" ])
 
        -- solveSimples may make progress if either float_eqs hold
        ; (unifs1, wc1) <- reportUnifications $