TcErrors.lhs 59.5 KB
Newer Older
1
\begin{code}
2
{-# LANGUAGE ScopedTypeVariables #-}
Ian Lynagh's avatar
Ian Lynagh committed
3 4 5 6
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
7
--     http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
Ian Lynagh's avatar
Ian Lynagh committed
8 9
-- for details

10
module TcErrors( 
11
       reportUnsolved, reportAllUnsolved,
12
       warnDefaulting,
13 14

       solverDepthErrorTcS
15 16 17 18
  ) where

#include "HsVersions.h"

19
import TcRnTypes
20 21 22
import TcRnMonad
import TcMType
import TcType
23
import TypeRep
batterseapower's avatar
batterseapower committed
24
import Type
25
import Kind ( isKind )
26
import Unify            ( tcMatchTys )
27
import Module
28 29 30
import Inst
import InstEnv
import TyCon
31
import DataCon
32
import TcEvidence
33
import TysWiredIn       ( coercibleClass )
34
import Name
35
import RdrName          ( lookupGRE_Name )
36
import Id 
37 38 39 40
import Var
import VarSet
import VarEnv
import Bag
41 42
import Maybes
import ErrUtils         ( ErrMsg, makeIntoWarning, pprLocErrMsg )
43
import BasicTypes 
44 45 46
import Util
import FastString
import Outputable
47
import SrcLoc
48
import DynFlags
49
import ListSetOps       ( equivClasses )
50
import Data.List        ( partition, mapAccumL, zip4 )
51 52 53 54 55 56 57 58 59 60 61 62
\end{code}

%************************************************************************
%*									*
\section{Errors and contexts}
%*									*
%************************************************************************

ToDo: for these error messages, should we note the location as coming
from the insts, or just whatever seems to be around in the monad just
now?

63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
Note [Deferring coercion errors to runtime]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
While developing, sometimes it is desirable to allow compilation to succeed even
if there are type errors in the code. Consider the following case:

  module Main where

  a :: Int
  a = 'a'

  main = print "b"

Even though `a` is ill-typed, it is not used in the end, so if all that we're
interested in is `main` it is handy to be able to ignore the problems in `a`.

Since we treat type equalities as evidence, this is relatively simple. Whenever
we run into a type mismatch in TcUnify, we normally just emit an error. But it
is always safe to defer the mismatch to the main constraint solver. If we do
that, `a` will get transformed into
82

83 84 85 86 87 88 89 90 91 92 93 94 95 96
  co :: Int ~ Char
  co = ...

  a :: Int
  a = 'a' `cast` co

The constraint solver would realize that `co` is an insoluble constraint, and
emit an error with `reportUnsolved`. But we can also replace the right-hand side
of `co` with `error "Deferred type error: Int ~ Char"`. This allows the program
to compile, and it will run fine unless we evaluate `a`. This is what
`deferErrorsToRuntime` does.

It does this by keeping track of which errors correspond to which coercion
in TcErrors. TcErrors.reportTidyWanteds does not print the errors
97
and does not fail if -fdefer-type-errors is on, so that we can continue
98 99 100 101 102 103
compilation. The errors are turned into warnings in `reportUnsolved`.

\begin{code}
reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
reportUnsolved wanted
  = do { binds_var <- newTcEvBinds
ian@well-typed.com's avatar
ian@well-typed.com committed
104
       ; defer <- goptM Opt_DeferTypeErrors
105 106 107 108 109 110
       ; report_unsolved (Just binds_var) defer wanted
       ; getTcEvBinds binds_var }

reportAllUnsolved :: WantedConstraints -> TcM ()
-- Report all unsolved goals, even if -fdefer-type-errors is on
-- See Note [Deferring coercion errors to runtime]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
111
reportAllUnsolved wanted = report_unsolved Nothing False wanted
112 113 114 115

report_unsolved :: Maybe EvBindsVar  -- cec_binds
                -> Bool              -- cec_defer
                -> WantedConstraints -> TcM ()
116 117 118
-- Important precondition:
-- WantedConstraints are fully zonked and unflattened, that is,
-- zonkWC has already been applied to these constraints.
119
report_unsolved mb_binds_var defer wanted
120
  | isEmptyWC wanted
121
  = return ()
122
  | otherwise
123
  = do { traceTc "reportUnsolved (before unflattening)" (ppr wanted)
124

125
       ; env0 <- tcInitTidyEnv
126 127 128
                 
            -- If we are deferring we are going to need /all/ evidence around,
            -- including the evidence produced by unflattening (zonkWC)
129
       ; let tidy_env = tidyFreeTyVars env0 free_tvs
130
             free_tvs = tyVarsOfWC wanted
131
             err_ctxt = CEC { cec_encl  = []
132
                            , cec_tidy  = tidy_env
133
                            , cec_defer    = defer
134
                            , cec_suppress = False -- See Note [Suppressing error messages]
135
                            , cec_binds    = mb_binds_var }
136

137 138 139
       ; traceTc "reportUnsolved (after unflattening):" $ 
         vcat [ pprTvBndrs (varSetElems free_tvs)
              , ppr wanted ]
140

141
       ; reportWanteds err_ctxt wanted }
142

143 144 145
--------------------------------------------
--      Internal functions
--------------------------------------------
146 147 148 149

data ReportErrCtxt 
    = CEC { cec_encl :: [Implication]  -- Enclosing implications
                	       	       --   (innermost first)
150
                                       -- ic_skols and givens are tidied, rest are not
151
          , cec_tidy  :: TidyEnv
152 153 154 155 156
          , cec_binds :: Maybe EvBindsVar 
                         -- Nothinng <=> Report all errors, including holes; no bindings
                         -- Just ev  <=> make some errors (depending on cec_defer)
                         --              into warnings, and emit evidence bindings
                         --              into 'ev' for unsolved constraints
157

158 159
          , cec_defer :: Bool       -- True <=> -fdefer-type-errors
                                    -- Irrelevant if cec_binds = Nothing
160 161 162
          , cec_suppress :: Bool    -- True <=> More important errors have occurred,
                                    --          so create bindings if need be, but
                                    --          don't issue any more errors/warnings
163
                                    -- See Note [Suppressing error messages]
164
      }
165
\end{code}
166

167 168 169 170 171 172 173 174 175 176 177 178 179
Note [Suppressing error messages]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The cec_suppress flag says "don't report any errors.  Instead, just create
evidence bindings (as usual).  It's used when more important errors have occurred.
Specifically (see reportWanteds)
  * If there are insoluble Givens, then we are in unreachable code and all bets
    are off.  So don't report any further errors.
  * If there are any insolubles (eg Int~Bool), here or in a nested implication, 
    then suppress errors from the flat constraints here.  Sometimes the
    flat-constraint errors are a knock-on effect of the insolubles.


\begin{code}
180 181 182
reportImplic :: ReportErrCtxt -> Implication -> TcM ()
reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
                                 , ic_wanted = wanted, ic_binds = evb
Simon Peyton Jones's avatar
Simon Peyton Jones committed
183
                                 , ic_insol = ic_insoluble, ic_info = info })
184
  | BracketSkol <- info
Simon Peyton Jones's avatar
Simon Peyton Jones committed
185 186 187 188
  , not ic_insoluble -- For Template Haskell brackets report only
  = return ()        -- definite errors. The whole thing will be re-checked
                     -- later when we plug it in, and meanwhile there may
                     -- certainly be un-satisfied constraints
189 190

  | otherwise
191
  = reportWanteds ctxt' wanted
192
  where
193
    (env1, tvs') = mapAccumL tidyTyVarBndr (cec_tidy ctxt) tvs
194
    (env2, info') = tidySkolemInfo env1 info
195
    implic' = implic { ic_skols = tvs'
196 197 198
                     , ic_given = map (tidyEvVar env2) given
                     , ic_info  = info' }
    ctxt' = ctxt { cec_tidy  = env2
199
                 , cec_encl  = implic' : cec_encl ctxt
200
                 , cec_binds = case cec_binds ctxt of
201 202 203 204
                                 Nothing -> Nothing
                                 Just {} -> Just evb }

reportWanteds :: ReportErrCtxt -> WantedConstraints -> TcM ()
205 206 207 208
reportWanteds ctxt wanted@(WC { wc_flat = flats, wc_insol = insols, wc_impl = implics })
  = do { reportFlats ctxt  (mapBag (tidyCt env) insol_given)
       ; reportFlats ctxt1 (mapBag (tidyCt env) insol_wanted)
       ; reportFlats ctxt2 (mapBag (tidyCt env) flats)
209 210 211 212
            -- All the Derived ones have been filtered out of flats 
            -- by the constraint solver. This is ok; we don't want
            -- to report unsolved Derived goals as errors
            -- See Note [Do not report derived but soluble errors]
213 214 215 216 217 218
       ; mapBagM_ (reportImplic ctxt1) implics }
            -- NB ctxt1: don't suppress inner insolubles if there's only a
            -- wanted insoluble here; but do suppress inner insolubles
            -- if there's a given insoluble here (= inaccessible code)
 where
    (insol_given, insol_wanted) = partitionBag isGivenCt insols
219 220
    env = cec_tidy ctxt

221 222 223 224 225 226 227
      -- See Note [Suppressing error messages]
    suppress0 = cec_suppress ctxt
    suppress1 = suppress0 || not (isEmptyBag insol_given)
    suppress2 = suppress0 || insolubleWC wanted
    ctxt1     = ctxt { cec_suppress = suppress1 }
    ctxt2     = ctxt { cec_suppress = suppress2 }

228 229
reportFlats :: ReportErrCtxt -> Cts -> TcM ()
reportFlats ctxt flats    -- Here 'flats' includes insolble goals
230 231 232
  =  traceTc "reportFlats" (vcat [ ptext (sLit "Flats =") <+> ppr flats
                                 , ptext (sLit "Suppress =") <+> ppr (cec_suppress ctxt)])
  >> tryReporters
233 234 235
      [ -- First deal with things that are utterly wrong
        -- Like Int ~ Bool (incl nullary TyCons)
        -- or  Int ~ t a   (AppTy on one side)
236 237
        ("Utterly wrong",  utterly_wrong,   True, mkGroupReporter mkEqErr)
      , ("Holes",          is_hole,         True, mkUniReporter mkHoleError)
238 239

        -- Report equalities of form (a~ty).  They are usually
240
        -- skolem-equalities, and they cause confusing knock-on
241
        -- effects in other errors; see test T4093b.
242 243 244 245 246 247 248 249 250 251 252 253
      , ("Skolem equalities", skolem_eq,  True,  mkSkolReporter)

        -- Other equalities; also confusing knock on effects
      , ("Equalities",      is_equality, True,  mkGroupReporter mkEqErr)

      , ("Implicit params", is_ip,       False, mkGroupReporter mkIPErr)
      , ("Irreds",          is_irred,    False, mkGroupReporter mkIrredErr)
      , ("Dicts",           is_dict,     False, mkGroupReporter mkDictErr)
      ]
      panicReporter ctxt (bagToList flats)
          -- TuplePreds should have been expanded away by the constraint
          -- simplifier, so they shouldn't show up at this point
254
  where
255 256 257 258
    utterly_wrong, skolem_eq, is_hole, is_dict,
      is_equality, is_ip, is_irred :: Ct -> PredTree -> Bool

    utterly_wrong _ (EqPred ty1 ty2) = isRigid ty1 && isRigid ty2
259 260
    utterly_wrong _ _ = False

261 262
    is_hole ct _ = isHoleCt ct

263
    skolem_eq _ (EqPred ty1 ty2) = isRigidOrSkol ty1 && isRigidOrSkol ty2
264 265
    skolem_eq _ _ = False

266 267 268 269 270 271 272 273 274 275 276 277 278
    is_equality _ (EqPred {}) = True
    is_equality _ _           = False

    is_dict _ (ClassPred {}) = True
    is_dict _ _              = False

    is_ip _ (ClassPred cls _) = isIPClass cls
    is_ip _ _                 = False

    is_irred _ (IrredPred {}) = True
    is_irred _ _              = False


279 280
---------------
isRigid, isRigidOrSkol :: Type -> Bool
281
isRigid ty
282 283 284 285 286
  | Just (tc,_) <- tcSplitTyConApp_maybe ty = isDecomposableTyCon tc
  | Just {} <- tcSplitAppTy_maybe ty        = True
  | isForAllTy ty                           = True
  | otherwise                               = False

287
isRigidOrSkol ty
288 289 290 291 292 293 294 295
  | Just tv <- getTyVar_maybe ty = isSkolemTyVar tv
  | otherwise                    = isRigid ty

isTyFun_maybe :: Type -> Maybe TyCon
isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of
                      Just (tc,_) | isSynFamilyTyCon tc -> Just tc
                      _ -> Nothing

296 297

--------------------------------------------
298
--      Reporters
299 300
--------------------------------------------

301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322
type Reporter
  = ReportErrCtxt -> [Ct] -> TcM ()
type ReporterSpec
  = ( String                     -- Name
    , Ct -> PredTree -> Bool     -- Pick these ones
    , Bool                       -- True <=> suppress subsequent reporters
    , Reporter)                  -- The reporter itself

panicReporter :: Reporter
panicReporter _ cts
  | null cts  = return ()
  | otherwise =  pprPanic "reportFlats" (ppr cts)

mkSkolReporter :: Reporter
-- Suppress duplicates with the same LHS
mkSkolReporter ctxt cts
  = mapM_ (reportGroup mkEqErr ctxt) (equivClasses cmp_lhs_type cts)
  where
    cmp_lhs_type ct1 ct2
      = case (classifyPredType (ctPred ct1), classifyPredType (ctPred ct2)) of
           (EqPred ty1 _, EqPred ty2 _) -> ty1 `cmpType` ty2
           _ -> pprPanic "mkSkolReporter" (ppr ct1 $$ ppr ct2)
323 324 325

mkUniReporter :: (ReportErrCtxt -> Ct -> TcM ErrMsg) -> Reporter
-- Reports errors one at a time
326 327
mkUniReporter mk_err ctxt
  = mapM_ $ \ct ->
328
    do { err <- mk_err ctxt ct
329
       ; maybeReportError ctxt err
330
       ; maybeAddDeferredBinding ctxt err ct }
331 332 333 334

mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)
                             -- Make error message for a group
                -> Reporter  -- Deal with lots of constraints
335 336 337 338 339
-- Group together errors from same location,
-- and report only the first (to avoid a cascade)
mkGroupReporter mk_err ctxt cts
  = mapM_ (reportGroup mk_err ctxt) (equivClasses cmp_loc cts)
  where
340
    cmp_loc ct1 ct2 = ctLocSpan (ctLoc ct1) `compare` ctLocSpan (ctLoc ct2)
341

342 343 344 345
reportGroup :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg) -> ReportErrCtxt
            -> [Ct] -> TcM ()
reportGroup mk_err ctxt cts
  = do { err <- mk_err ctxt cts
346
       ; maybeReportError ctxt err
347
       ; mapM_ (maybeAddDeferredBinding ctxt err) cts }
348
               -- Add deferred bindings for all
349
               -- But see Note [Always warn with -fdefer-type-errors]
350

351
maybeReportError :: ReportErrCtxt -> ErrMsg -> TcM ()
352
-- Report the error and/or make a deferred binding for it
353
maybeReportError ctxt err
354
  | cec_defer ctxt  -- See Note [Always warn with -fdefer-type-errors]
355
  = reportWarning (makeIntoWarning err)
356 357 358 359 360 361 362 363
  | cec_suppress ctxt
  = return ()
  | otherwise
  = reportError err

maybeAddDeferredBinding :: ReportErrCtxt -> ErrMsg -> Ct -> TcM ()
-- See Note [Deferring coercion errors to runtime]
maybeAddDeferredBinding ctxt err ct
364
  | CtWanted { ctev_pred = pred, ctev_evar = ev_id } <- ctEvidence ct
365 366
    -- Only add deferred bindings for Wanted constraints
  , isHoleCt ct || cec_defer ctxt  -- And it's a hole or we have -fdefer-type-errors
367
  , Just ev_binds_var <- cec_binds ctxt  -- We have somewhere to put the bindings
368 369 370 371 372 373 374 375 376
  = do { dflags <- getDynFlags
       ; let err_msg = pprLocErrMsg err
             err_fs  = mkFastString $ showSDoc dflags $
                       err_msg $$ text "(deferred type error)"

         -- Create the binding
       ; addTcEvBind ev_binds_var ev_id (EvDelayedError pred err_fs) }

  | otherwise   -- Do not set any evidence for Given/Derived
377
  = return ()
378

379
tryReporters :: [ReporterSpec] -> Reporter -> Reporter
380 381
-- Use the first reporter in the list whose predicate says True
tryReporters reporters deflt ctxt cts
382
  = do { traceTc "tryReporters {" (ppr cts)
383
       ; go ctxt reporters cts
384 385
       ; traceTc "tryReporters }" empty }
  where
386 387
    go ctxt [] cts = deflt ctxt cts
    go ctxt ((str, pred, suppress_after, reporter) : rs) cts
388 389 390 391
      | null yeses  = do { traceTc "tryReporters: no" (text str)
                         ; go ctxt rs cts }
      | otherwise   = do { traceTc "tryReporters: yes" (text str <+> ppr yeses)
                         ; reporter ctxt yeses :: TcM ()
392 393
                         ; let ctxt' = ctxt { cec_suppress = suppress_after || cec_suppress ctxt }
                         ; go ctxt' rs nos }
394
                         -- Carry on with the rest, because we must make
395
                         -- deferred bindings for them if we have
396
                         -- -fdefer-type-errors
Simon Peyton Jones's avatar
Simon Peyton Jones committed
397
                         -- But suppress their error messages
398
      where
399
       (yeses, nos) = partition keep_me cts
400
       keep_me ct = pred ct (classifyPredType (ctPred ct))
401 402

-- Add the "arising from..." part to a message about bunch of dicts
403
addArising :: CtOrigin -> SDoc -> SDoc
404
addArising orig msg = hang msg 2 (pprArising orig)
405

406
pprWithArising :: [Ct] -> (CtLoc, SDoc)
407 408
-- Print something like
--    (Eq a) arising from a use of x at y
409 410
--    (Show a) arising from a use of p at q
-- Also return a location for the error message
411
-- Works for Wanted/Derived only
412 413
pprWithArising [] 
  = panic "pprWithArising"
414 415
pprWithArising (ct:cts)
  | null cts
416
  = (loc, addArising (ctLocOrigin loc) 
dimitris's avatar
dimitris committed
417
                     (pprTheta [ctPred ct]))
418 419
  | otherwise
  = (loc, vcat (map ppr_one (ct:cts)))
420
  where
421 422 423
    loc = ctLoc ct
    ppr_one ct' = hang (parens (pprType (ctPred ct'))) 
                     2 (pprArisingAt (ctLoc ct'))
424

425 426
mkErrorMsg :: ReportErrCtxt -> Ct -> SDoc -> TcM ErrMsg
mkErrorMsg ctxt ct msg 
427
  = do { let tcl_env = ctLocEnv (ctLoc ct)
428 429
       ; err_info <- mkErrInfo (cec_tidy ctxt) (tcl_ctxt tcl_env)
       ; mkLongErrAt (tcl_loc tcl_env) msg err_info }
430

431
type UserGiven = ([EvVar], SkolemInfo, SrcSpan)
432 433

getUserGivens :: ReportErrCtxt -> [UserGiven]
434
-- One item for each enclosing implication
435
getUserGivens (CEC {cec_encl = ctxt})
436
  = reverse $
437 438 439
    [ (givens, info, tcl_loc env) 
    | Implic {ic_given = givens, ic_env = env, ic_info = info } <- ctxt
    , not (null givens) ]
440 441
\end{code}

442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457
Note [Always warn with -fdefer-type-errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When -fdefer-type-errors is on we warn about *all* type errors, even
if cec_suppress is on.  This can lead to a lot more warnings than you
would get errors without -fdefer-type-errors, but if we suppress any of
them you might get a runtime error that wasn't warned about at compile
time. 

This is an easy design choice to change; just flip the order of the
first two equations for maybeReportError

To be consistent, we should also report multiple warnings from a single
location in mkGroupReporter, when -fdefer-type-errors is on.  But that 
is perhaps a bit *over*-consistent! Again, an easy choice to change.


458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507
Note [Do not report derived but soluble errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The wc_flats include Derived constraints that have not been solved, but are
not insoluble (in that case they'd be in wc_insols).  We do not want to report
these as errors:

* Superclass constraints. If we have an unsolved [W] Ord a, we'll also have
  an unsolved [D] Eq a, and we do not want to report that; it's just noise.

* Functional dependencies.  For givens, consider
      class C a b | a -> b
      data T a where
         MkT :: C a d => [d] -> T a
      f :: C a b => T a -> F Int
      f (MkT xs) = length xs
  Then we get a [D] b~d.  But there *is* a legitimate call to
  f, namely   f (MkT [True]) :: T Bool, in which b=d.  So we should
  not reject the program.

  For wanteds, something similar
      data T a where
        MkT :: C Int b => a -> b -> T a 
      g :: C Int c => c -> ()
      f :: T a -> ()
      f (MkT x y) = g x
  Here we get [G] C Int b, [W] C Int a, hence [D] a~b.
  But again f (MkT True True) is a legitimate call.

(We leave the Deriveds in wc_flat until reportErrors, so that we don't lose
derived superclasses between iterations of the solver.)

For functional dependencies, here is a real example, 
stripped off from libraries/utf8-string/Codec/Binary/UTF8/Generic.hs

  class C a b | a -> b
  g :: C a b => a -> b -> () 
  f :: C a b => a -> b -> () 
  f xa xb = 
      let loop = g xa 
      in loop xb

We will first try to infer a type for loop, and we will succeed:
    C a b' => b' -> ()
Subsequently, we will type check (loop xb) and all is good. But, 
recall that we have to solve a final implication constraint: 
    C a b => (C a b' => .... cts from body of loop .... )) 
And now we have a problem as we will generate an equality b ~ b' and fail to 
solve it. 


batterseapower's avatar
batterseapower committed
508 509 510 511 512 513 514
%************************************************************************
%*                  *
                Irreducible predicate errors
%*                  *
%************************************************************************

\begin{code}
515 516
mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
mkIrredErr ctxt cts 
517
  = do { (ctxt, binds_msg) <- relevantBindings True ctxt ct1
518
       ; mkErrorMsg ctxt ct1 (msg $$ binds_msg) }
batterseapower's avatar
batterseapower committed
519
  where
520
    (ct1:_) = cts
521
    orig    = ctLocOrigin (ctLoc ct1)
522 523
    givens  = getUserGivens ctxt
    msg = couldNotDeduce givens (map ctPred cts, orig)
batterseapower's avatar
batterseapower committed
524

525
----------------
526
mkHoleError :: ReportErrCtxt -> Ct -> TcM ErrMsg
527
mkHoleError ctxt ct@(CHoleCan { cc_occ = occ })
528 529
  = do { let tyvars = varSetElems (tyVarsOfCt ct)
             tyvars_msg = map loc_msg tyvars
530
             msg = vcat [ hang (ptext (sLit "Found hole") <+> quotes (ppr occ))
531
                             2 (ptext (sLit "with type:") <+> pprType (ctEvPred (ctEvidence ct)))
532
                        , ppUnless (null tyvars_msg) (ptext (sLit "Where:") <+> vcat tyvars_msg) ]
533 534
       ; (ctxt, binds_doc) <- relevantBindings False ctxt ct
               -- The 'False' means "don't filter the bindings; see Trac #8191
535
       ; mkErrorMsg ctxt ct (msg $$ binds_doc) }
536
  where
537 538 539
    loc_msg tv 
       = case tcTyVarDetails tv of
          SkolemTv {} -> quotes (ppr tv) <+> skol_msg
540
          MetaTv {}   -> quotes (ppr tv) <+> ptext (sLit "is an ambiguous type variable")
541 542 543
          det -> pprTcTyVarDetails det
       where 
          skol_msg = pprSkol (getSkolemInfo (cec_encl ctxt) tv) (getSrcLoc tv)
544 545

mkHoleError _ ct = pprPanic "mkHoleError" (ppr ct)
546

547
----------------
548 549
mkIPErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
mkIPErr ctxt cts
550
  = do { (ctxt, bind_msg) <- relevantBindings True ctxt ct1
551
       ; mkErrorMsg ctxt ct1 (msg $$ bind_msg) }
552
  where
553
    (ct1:_) = cts
554
    orig    = ctLocOrigin (ctLoc ct1)
555 556
    preds   = map ctPred cts
    givens  = getUserGivens ctxt
557 558
    msg | null givens
        = addArising orig $
559 560
          sep [ ptext (sLit "Unbound implicit parameter") <> plural cts
              , nest 2 (pprTheta preds) ] 
561
        | otherwise
562
        = couldNotDeduce givens (preds, orig)
563 564 565 566 567 568 569 570 571
\end{code}


%************************************************************************
%*									*
                Equality errors
%*									*
%************************************************************************

572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589
Note [Inaccessible code]
~~~~~~~~~~~~~~~~~~~~~~~~
Consider
   data T a where
     T1 :: T a
     T2 :: T Bool

   f :: (a ~ Int) => T a -> Int
   f T1 = 3
   f T2 = 4   -- Unreachable code

Here the second equation is unreachable. The original constraint
(a~Int) from the signature gets rewritten by the pattern-match to
(Bool~Int), so the danger is that we report the error as coming from
the *signature* (Trac #7293).  So, for Given errors we replace the
env (and hence src-loc) on its CtLoc with that from the immediately
enclosing implication.

590
\begin{code}
591 592 593 594 595 596 597 598 599
mkEqErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
-- Don't have multiple equality errors from the same location
-- E.g.   (Int,Bool) ~ (Bool,Int)   one error will do!
mkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct
mkEqErr _ [] = panic "mkEqErr"

mkEqErr1 :: ReportErrCtxt -> Ct -> TcM ErrMsg
-- Wanted constraints only!
mkEqErr1 ctxt ct
600
  | isGiven ev
601
  = do { (ctxt, binds_msg) <- relevantBindings True ctxt ct
602
       ; let (given_loc, given_msg) = mk_given (cec_encl ctxt)
603 604
       ; dflags <- getDynFlags
       ; mkEqErr_help dflags ctxt (given_msg $$ binds_msg) 
605
                      (ct { cc_ev = ev {ctev_loc = given_loc}}) -- Note [Inaccessible code]
606 607 608
                      Nothing ty1 ty2 }

  | otherwise   -- Wanted or derived
609
  = do { (ctxt, binds_msg) <- relevantBindings True ctxt ct
610
       ; (ctxt, tidy_orig) <- zonkTidyOrigin ctxt (ctLocOrigin loc)
611
       ; let (is_oriented, wanted_msg) = mk_wanted_extra tidy_orig
612 613
       ; dflags <- getDynFlags
       ; mkEqErr_help dflags ctxt (wanted_msg $$ binds_msg) 
614
                      ct is_oriented ty1 ty2 }
615
  where
616 617
    ev         = ctEvidence ct
    loc        = ctev_loc ev
618 619 620 621 622
    (ty1, ty2) = getEqPredTys (ctEvPred ev)

    mk_given :: [Implication] -> (CtLoc, SDoc)
    -- For given constraints we overwrite the env (and hence src-loc)
    -- with one from the implication.  See Note [Inaccessible code]
623 624
    mk_given []           = (loc, empty)
    mk_given (implic : _) = (setCtLocEnv loc (ic_env implic)
625 626
                            , hang (ptext (sLit "Inaccessible code in"))
                                 2 (ppr (ic_info implic)))
627

628 629
       -- If the types in the error message are the same as the types
       -- we are unifying, don't add the extra expected/actual message
630 631 632 633 634
    mk_wanted_extra orig@(TypeEqOrigin {})
      = mkExpectedActualMsg ty1 ty2 orig

    mk_wanted_extra (KindEqOrigin cty1 cty2 sub_o)
      = (Nothing, msg1 $$ msg2)
635
      where
636 637 638 639 640 641 642 643
        msg1 = hang (ptext (sLit "When matching types"))
                  2 (vcat [ ppr cty1 <+> dcolon <+> ppr (typeKind cty1)
                          , ppr cty2 <+> dcolon <+> ppr (typeKind cty2) ])
        msg2 = case sub_o of
                 TypeEqOrigin {} -> snd (mkExpectedActualMsg cty1 cty2 sub_o)
                 _ -> empty

    mk_wanted_extra _ = (Nothing, empty)
644

645 646 647 648 649 650 651
mkEqErr_help :: DynFlags -> ReportErrCtxt -> SDoc
             -> Ct          
             -> Maybe SwapFlag   -- Nothing <=> not sure
             -> TcType -> TcType -> TcM ErrMsg
mkEqErr_help dflags ctxt extra ct oriented ty1 ty2
  | Just tv1 <- tcGetTyVar_maybe ty1 = mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
  | Just tv2 <- tcGetTyVar_maybe ty2 = mkTyVarEqErr dflags ctxt extra ct swapped  tv2 ty1
652
  | otherwise                        = reportEqErr  ctxt extra ct oriented ty1 ty2
653 654
  where
    swapped = fmap flipSwap oriented
655

656 657 658 659
reportEqErr :: ReportErrCtxt -> SDoc
            -> Ct    
            -> Maybe SwapFlag   -- Nothing <=> not sure
            -> TcType -> TcType -> TcM ErrMsg
660
reportEqErr ctxt extra1 ct oriented ty1 ty2
661 662
  = do { let extra2 = mkEqInfoMsg ct ty1 ty2
       ; mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2
663
                                   , extra2, extra1]) }
664

665 666
mkTyVarEqErr :: DynFlags -> ReportErrCtxt -> SDoc -> Ct 
             -> Maybe SwapFlag -> TcTyVar -> TcType -> TcM ErrMsg
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
667
-- tv1 and ty2 are already tidied
668 669 670
mkTyVarEqErr dflags ctxt extra ct oriented tv1 ty2
  | isUserSkolem ctxt tv1   -- ty2 won't be a meta-tyvar, or else the thing would
                            -- be oriented the other way round; see TcCanonical.reOrient
671
  || isSigTyVar tv1 && not (isTyVarTy ty2)
672 673 674
  = mkErrorMsg ctxt ct (vcat [ misMatchOrCND ctxt ct oriented ty1 ty2
                             , extraTyVarInfo ctxt ty1 ty2
                             , extra ])
675

676 677 678
  -- So tv is a meta tyvar (or started that way before we 
  -- generalised it).  So presumably it is an *untouchable* 
  -- meta tyvar or a SigTv, else it'd have been unified
679
  | not (k2 `tcIsSubKind` k1)   	 -- Kind error
680
  = mkErrorMsg ctxt ct $ (kindErrorMsg (mkTyVarTy tv1) ty2 $$ extra)
681

682
  | OC_Occurs <- occ_check_expand
683 684
  = do { let occCheckMsg = hang (text "Occurs check: cannot construct the infinite type:")
                              2 (sep [ppr ty1, char '~', ppr ty2])
685 686
             extra2 = mkEqInfoMsg ct ty1 ty2
       ; mkErrorMsg ctxt ct (occCheckMsg $$ extra2 $$ extra) }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
687

688 689 690 691
  | OC_Forall <- occ_check_expand
  = do { let msg = vcat [ ptext (sLit "Cannot instantiate unification variable")
                          <+> quotes (ppr tv1)
                        , hang (ptext (sLit "with a type involving foralls:")) 2 (ppr ty2)
692
                        , nest 2 (ptext (sLit "Perhaps you want ImpredicativeTypes")) ]
693 694 695 696
       ; mkErrorMsg ctxt ct msg }

  -- If the immediately-enclosing implication has 'tv' a skolem, and
  -- we know by now its an InferSkol kind of skolem, then presumably
697 698
  -- it started life as a SigTv, else it'd have been unified, given
  -- that there's no occurs-check or forall problem
699 700 701 702 703 704 705
  | (implic:_) <- cec_encl ctxt
  , Implic { ic_skols = skols } <- implic
  , tv1 `elem` skols
  = mkErrorMsg ctxt ct (vcat [ misMatchMsg oriented ty1 ty2
                             , extraTyVarInfo ctxt ty1 ty2
                             , extra ])

706 707
  -- Check for skolem escape
  | (implic:_) <- cec_encl ctxt   -- Get the innermost context
708 709
  , Implic { ic_env = env, ic_skols = skols, ic_info = skol_info } <- implic
  , let esc_skols = filter (`elemVarSet` (tyVarsOfType ty2)) skols
710
  , not (null esc_skols)
711
  = do { let msg = misMatchMsg oriented ty1 ty2
712 713 714 715 716
             esc_doc = sep [ ptext (sLit "because type variable") <> plural esc_skols
                             <+> pprQuotedList esc_skols
                           , ptext (sLit "would escape") <+>
                             if isSingleton esc_skols then ptext (sLit "its scope")
                                                      else ptext (sLit "their scope") ]
717 718 719 720 721 722 723 724
             tv_extra = vcat [ nest 2 $ esc_doc
                             , sep [ (if isSingleton esc_skols 
                                      then ptext (sLit "This (rigid, skolem) type variable is")
                                      else ptext (sLit "These (rigid, skolem) type variables are"))
                               <+> ptext (sLit "bound by")
                             , nest 2 $ ppr skol_info
                             , nest 2 $ ptext (sLit "at") <+> ppr (tcl_loc env) ] ]
       ; mkErrorMsg ctxt ct (msg $$ tv_extra $$ extra) }
725 726 727

  -- Nastiest case: attempt to unify an untouchable variable
  | (implic:_) <- cec_encl ctxt   -- Get the innermost context
728 729 730 731 732 733 734 735 736 737
  , Implic { ic_env = env, ic_given = given, ic_info = skol_info } <- implic
  = do { let msg = misMatchMsg oriented ty1 ty2
             untch_extra 
                = nest 2 $
                  sep [ quotes (ppr tv1) <+> ptext (sLit "is untouchable")
                      , nest 2 $ ptext (sLit "inside the constraints") <+> pprEvVarTheta given
                      , nest 2 $ ptext (sLit "bound by") <+> ppr skol_info
                      , nest 2 $ ptext (sLit "at") <+> ppr (tcl_loc env) ]
             tv_extra = extraTyVarInfo ctxt ty1 ty2
       ; mkErrorMsg ctxt ct (vcat [msg, untch_extra, tv_extra, extra]) }
738

739
  | otherwise
740
  = reportEqErr ctxt extra ct oriented (mkTyVarTy tv1) ty2
741 742
        -- This *can* happen (Trac #6123, and test T2627b)
        -- Consider an ambiguous top-level constraint (a ~ F a)
Gabor Greif's avatar
typos  
Gabor Greif committed
743
        -- Not an occurs check, because F is a type function.
744
  where         
745
    occ_check_expand = occurCheckExpand dflags tv1 ty2
746 747 748
    k1 	= tyVarKind tv1
    k2 	= typeKind ty2
    ty1 = mkTyVarTy tv1
749

750
mkEqInfoMsg :: Ct -> TcType -> TcType -> SDoc
751 752 753 754 755
-- Report (a) ambiguity if either side is a type function application
--            e.g. F a0 ~ Int    
--        (b) warning about injectivity if both sides are the same
--            type function application   F a ~ F b
--            See Note [Non-injective type functions]
756 757
mkEqInfoMsg ct ty1 ty2
  = tyfun_msg $$ ambig_msg
758 759 760
  where
    mb_fun1 = isTyFun_maybe ty1
    mb_fun2 = isTyFun_maybe ty2
761 762 763 764 765

    ambig_msg | isJust mb_fun1 || isJust mb_fun2 
              = snd (mkAmbigMsg ct)
              | otherwise = empty

766 767 768 769 770 771 772
    tyfun_msg | Just tc1 <- mb_fun1
              , Just tc2 <- mb_fun2
              , tc1 == tc2 
              = ptext (sLit "NB:") <+> quotes (ppr tc1) 
                <+> ptext (sLit "is a type function, and may not be injective")
              | otherwise = empty

Simon Peyton Jones's avatar
Simon Peyton Jones committed
773 774 775 776 777 778 779 780 781 782 783
isUserSkolem :: ReportErrCtxt -> TcTyVar -> Bool
-- See Note [Reporting occurs-check errors]
isUserSkolem ctxt tv
  = isSkolemTyVar tv && any is_user_skol_tv (cec_encl ctxt)
  where
    is_user_skol_tv (Implic { ic_skols = sks, ic_info = skol_info })
      = tv `elem` sks && is_user_skol_info skol_info

    is_user_skol_info (InferSkol {}) = False
    is_user_skol_info _ = True

784
misMatchOrCND :: ReportErrCtxt -> Ct -> Maybe SwapFlag -> TcType -> TcType -> SDoc
Simon Peyton Jones's avatar
Simon Peyton Jones committed
785
-- If oriented then ty1 is actual, ty2 is expected
786 787 788
misMatchOrCND ctxt ct oriented ty1 ty2
  | null givens || 
    (isRigid ty1 && isRigid ty2) || 
789
    isGivenCt ct
790 791 792 793
       -- If the equality is unconditionally insoluble
       -- or there is no context, don't report the context
  = misMatchMsg oriented ty1 ty2
  | otherwise      
794
  = couldNotDeduce givens ([mkEqPred ty1 ty2], orig)
795 796
  where
    givens = getUserGivens ctxt
Simon Peyton Jones's avatar
Simon Peyton Jones committed
797
    orig   = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2 }
798

799
couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> SDoc
800
couldNotDeduce givens (wanteds, orig)
801
  = vcat [ addArising orig (ptext (sLit "Could not deduce") <+> pprTheta wanteds)
dimitris's avatar
dimitris committed
802 803
         , vcat (pp_givens givens)]

804
pp_givens :: [UserGiven] -> [SDoc]
dimitris's avatar
dimitris committed
805 806
pp_givens givens 
   = case givens of
807 808 809
         []     -> []
         (g:gs) ->      ppr_given (ptext (sLit "from the context")) g
                 : map (ppr_given (ptext (sLit "or from"))) gs
810 811
    where 
       ppr_given herald (gs, skol_info, loc)
dimitris's avatar
dimitris committed
812
           = hang (herald <+> pprEvVarTheta gs)
813 814
                2 (sep [ ptext (sLit "bound by") <+> ppr skol_info
                       , ptext (sLit "at") <+> ppr loc])
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
815

816
extraTyVarInfo :: ReportErrCtxt -> TcType -> TcType -> SDoc
817 818
-- Add on extra info about the types themselves
-- NB: The types themselves are already tidied
819 820
extraTyVarInfo ctxt ty1 ty2
  = nest 2 (extra1 $$ extra2)
821
  where
822 823
    extra1 = tyVarExtraInfoMsg (cec_encl ctxt) ty1
    extra2 = tyVarExtraInfoMsg (cec_encl ctxt) ty2
824

825
tyVarExtraInfoMsg :: [Implication] -> Type -> SDoc
826
-- Shows a bit of extra info about skolem constants
827
tyVarExtraInfoMsg implics ty
828
  | Just tv <- tcGetTyVar_maybe ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
829 830 831
  , isTcTyVar tv, isSkolemTyVar tv
  , let pp_tv = quotes (ppr tv)
 = case tcTyVarDetails tv of
832
    SkolemTv {}   -> pp_tv <+> pprSkol (getSkolemInfo implics tv) (getSrcLoc tv)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
833 834 835 836 837 838 839
    FlatSkol {}   -> pp_tv <+> ptext (sLit "is a flattening type variable")
    RuntimeUnk {} -> pp_tv <+> ptext (sLit "is an interactive-debugger skolem")
    MetaTv {}     -> empty

 | otherwise             -- Normal case
 = empty
 
840 841 842 843 844 845 846 847 848
kindErrorMsg :: TcType -> TcType -> SDoc   -- Types are already tidy
kindErrorMsg ty1 ty2
  = vcat [ ptext (sLit "Kind incompatibility when matching types:")
         , nest 2 (vcat [ ppr ty1 <+> dcolon <+> ppr k1
                        , ppr ty2 <+> dcolon <+> ppr k2 ]) ]
  where
    k1 = typeKind ty1
    k2 = typeKind ty2

849
--------------------
850
misMatchMsg :: Maybe SwapFlag -> TcType -> TcType -> SDoc	   -- Types are already tidy
851
-- If oriented then ty1 is actual, ty2 is expected
852
misMatchMsg oriented ty1 ty2
853 854 855
  | Just IsSwapped <- oriented
  = misMatchMsg (Just NotSwapped) ty2 ty1
  | Just NotSwapped <- oriented
856
  = sep [ ptext (sLit "Couldn't match expected") <+> what <+> quotes (ppr ty2)
857 858
        , nest 12 $   ptext (sLit "with actual") <+> what <+> quotes (ppr ty1)
        , sameOccExtra ty2 ty1 ]
859 860
  | otherwise
  = sep [ ptext (sLit "Couldn't match") <+> what <+> quotes (ppr ty1)
861 862 863
        , nest 14 $ ptext (sLit "with") <+> quotes (ppr ty2)
        , sameOccExtra ty1 ty2 ]
  where
864 865
    what | isKind ty1 = ptext (sLit "kind")
         | otherwise  = ptext (sLit "type")
866

867
mkExpectedActualMsg :: Type -> Type -> CtOrigin -> (Maybe SwapFlag, SDoc)
868
-- NotSwapped means (actual, expected), IsSwapped is the reverse
869
mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act, uo_expected = exp })
870 871
  | act `pickyEqType` ty1, exp `pickyEqType` ty2 = (Just NotSwapped,  empty)
  | exp `pickyEqType` ty1, act `pickyEqType` ty2 = (Just IsSwapped, empty)
872 873 874 875 876 877
  | otherwise                                    = (Nothing, msg)
  where
    msg = vcat [ text "Expected type:" <+> ppr exp
               , text "  Actual type:" <+> ppr act ]

mkExpectedActualMsg _ _ _ = panic "mkExprectedAcutalMsg"
878 879

sameOccExtra :: TcType -> TcType -> SDoc
880
-- See Note [Disambiguating (X ~ X) errors]
881 882 883 884 885 886 887 888 889 890 891 892 893 894
sameOccExtra ty1 ty2
  | Just (tc1, _) <- tcSplitTyConApp_maybe ty1
  , Just (tc2, _) <- tcSplitTyConApp_maybe ty2
  , let n1 = tyConName tc1
        n2 = tyConName tc2
        same_occ = nameOccName n1                  == nameOccName n2
        same_pkg = modulePackageId (nameModule n1) == modulePackageId (nameModule n2)
  , n1 /= n2   -- Different Names
  , same_occ   -- but same OccName
  = ptext (sLit "NB:") <+> (ppr_from same_pkg n1 $$ ppr_from same_pkg n2)
  | otherwise
  = empty
  where
    ppr_from same_pkg nm
895 896 897 898
      | isGoodSrcSpan loc
      = hang (quotes (ppr nm) <+> ptext (sLit "is defined at"))
           2 (ppr loc)
      | otherwise  -- Imported things have an UnhelpfulSrcSpan
899 900 901 902 903 904 905
      = hang (quotes (ppr nm))
           2 (sep [ ptext (sLit "is defined in") <+> quotes (ppr (moduleName mod))
                  , ppUnless (same_pkg || pkg == mainPackageId) $
                    nest 4 $ ptext (sLit "in package") <+> quotes (ppr pkg) ])
       where
         pkg = modulePackageId mod
         mod = nameModule nm
906
         loc = nameSrcSpan nm
907 908
\end{code}

909 910 911 912
Note [Disambiguating (X ~ X) errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See Trac #8278

Simon Peyton Jones's avatar
Simon Peyton Jones committed
913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930
Note [Reporting occurs-check errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Given (a ~ [a]), if 'a' is a rigid type variable bound by a user-supplied
type signature, then the best thing is to report that we can't unify
a with [a], because a is a skolem variable.  That avoids the confusing
"occur-check" error message.

But nowadays when inferring the type of a function with no type signature,
even if there are errors inside, we still generalise its signature and
carry on. For example
   f x = x:x
Here we will infer somethiing like
   f :: forall a. a -> [a]
with a suspended error of (a ~ [a]).  So 'a' is now a skolem, but not
one bound by the programmer!  Here we really should report an occurs check.

So isUserSkolem distinguishes the two.

931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948
Note [Non-injective type functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's very confusing to get a message like
     Couldn't match expected type `Depend s'
            against inferred type `Depend s1'
so mkTyFunInfoMsg adds:
       NB: `Depend' is type function, and hence may not be injective

Warn of loopy local equalities that were dropped.


%************************************************************************
%*									*
                 Type-class errors
%*									*
%************************************************************************

\begin{code}
949 950
mkDictErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
mkDictErr ctxt cts 
951 952 953 954 955 956 957
  = ASSERT( not (null cts) )
    do { inst_envs <- tcGetInstEnvs
       ; lookups   <- mapM (lookup_cls_inst inst_envs) cts
       ; let (no_inst_cts, overlap_cts) = partition is_no_inst lookups

       -- Report definite no-instance errors, 
       -- or (iff there are none) overlap errors
Gabor Greif's avatar
typos  
Gabor Greif committed
958
       -- But we report only one of them (hence 'head') because they all
959 960
       -- have the same source-location origin, to try avoid a cascade
       -- of error from one location
961
       ; (ctxt, err) <- mk_dict_err ctxt (head (no_inst_cts ++ overlap_cts))
962
       ; mkErrorMsg ctxt ct1 err }
963
  where
964 965
    ct1:_ = elim_superclasses cts

966
    no_givens = null (getUserGivens ctxt)
967

968
    is_no_inst (ct, (matches, unifiers, _))
969 970
      =  no_givens
      && null matches
971
      && (null unifiers || all (not . isAmbiguousTyVar) (varSetElems (tyVarsOfCt ct)))
972

973 974 975 976
    lookup_cls_inst inst_envs ct
      = do { tys_flat <- mapM quickFlattenTy tys
                -- Note [Flattening in error message generation]
           ; return (ct, lookupInstEnv inst_envs clas tys_flat) }
977
      where
978
        (clas, tys) = getClassPredTys (ctPred ct)
979

980 981 982 983 984 985 986 987 988

    -- When simplifying [W] Ord (Set a), we need
    --    [W] Eq a, [W] Ord a
    -- but we really only want to report the latter
    elim_superclasses cts
      = filter (\ct -> any (eqPred (ctPred ct)) min_preds) cts
      where
        min_preds = mkMinimalBySCs (map ctPred cts)

989
mk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult)
990
            -> TcM (ReportErrCtxt, SDoc)
991 992 993 994
-- Report an overlap error if this class constraint results
-- from an overlap (returning Left clas), otherwise return (Right pred)
mk_dict_err ctxt (ct, (matches, unifiers, safe_haskell)) 
  | null matches  -- No matches but perhaps several unifiers
995
  = do { let (is_ambig, ambig_msg) = mkAmbigMsg ct
996
       ; (ctxt, binds_msg) <- relevantBindings True ctxt ct
Simon Peyton Jones's avatar
Simon Peyton Jones committed
997
       ; traceTc "mk_dict_err" (ppr ct $$ ppr is_ambig $$ ambig_msg)
998 999 1000
       ; safe_mod <- safeLanguageOn `fmap` getDynFlags
       ; rdr_env <- getGlobalRdrEnv
       ; return (ctxt, cannot_resolve_msg safe_mod rdr_env is_ambig binds_msg ambig_msg) }