{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}

-- | Describes the provenance of types as they flow through the type-checker.
-- The datatypes here are mainly used for error message generation.
module GHC.Tc.Types.Origin (
  -- UserTypeCtxt
  UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,

  -- SkolemInfo
  SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,

  -- CtOrigin
  CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
  isVisibleOrigin, toInvisibleOrigin,
  pprCtOrigin, isGivenOrigin

  ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Tc.Utils.TcType

import GHC.Hs

import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.PatSyn
import GHC.Core.Multiplicity ( scaledThing )

import GHC.Unit.Module
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.Basic
import GHC.Types.SrcLoc

import GHC.Data.FastString

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Driver.Ppr

{- *********************************************************************
*                                                                      *
          UserTypeCtxt
*                                                                      *
********************************************************************* -}

-------------------------------------
-- | UserTypeCtxt describes the origin of the polymorphic type
-- in the places where we need an expression to have that type
data UserTypeCtxt
  = FunSigCtxt      -- Function type signature, when checking the type
                    -- Also used for types in SPECIALISE pragmas
       Name              -- Name of the function
       Bool              -- True <=> report redundant constraints
                            -- This is usually True, but False for
                            --   * Record selectors (not important here)
                            --   * Class and instance methods.  Here
                            --     the code may legitimately be more
                            --     polymorphic than the signature
                            --     generated from the class
                            --     declaration

  | InfSigCtxt Name     -- Inferred type for function
  | ExprSigCtxt         -- Expression type signature
  | KindSigCtxt         -- Kind signature
  | StandaloneKindSigCtxt  -- Standalone kind signature
       Name                -- Name of the type/class
  | TypeAppCtxt         -- Visible type application
  | ConArgCtxt Name     -- Data constructor argument
  | TySynCtxt Name      -- RHS of a type synonym decl
  | PatSynCtxt Name     -- Type sig for a pattern synonym
  | PatSigCtxt          -- Type sig in pattern
                        --   eg  f (x::t) = ...
                        --   or  (x::t, y) = e
  | RuleSigCtxt Name    -- LHS of a RULE forall
                        --    RULE "foo" forall (x :: a -> a). f (Just x) = ...
  | ForSigCtxt Name     -- Foreign import or export signature
  | DefaultDeclCtxt     -- Types in a default declaration
  | InstDeclCtxt Bool   -- An instance declaration
                        --    True:  stand-alone deriving
                        --    False: vanilla instance declaration
  | SpecInstCtxt        -- SPECIALISE instance pragma
  | GenSigCtxt          -- Higher-rank or impredicative situations
                        -- e.g. (f e) where f has a higher-rank type
                        -- We might want to elaborate this
  | GhciCtxt Bool       -- GHCi command :kind <type>
                        -- The Bool indicates if we are checking the outermost
                        -- type application.
                        -- See Note [Unsaturated type synonyms in GHCi] in
                        -- GHC.Tc.Validity.

  | ClassSCCtxt Name    -- Superclasses of a class
  | SigmaCtxt           -- Theta part of a normal for-all type
                        --      f :: <S> => a -> a
  | DataTyCtxt Name     -- The "stupid theta" part of a data decl
                        --      data <S> => T a = MkT a
  | DerivClauseCtxt     -- A 'deriving' clause
  | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound
  | DataKindCtxt Name   -- The kind of a data/newtype (instance)
  | TySynKindCtxt Name  -- The kind of the RHS of a type synonym
  | TyFamResKindCtxt Name   -- The result kind of a type family

{-
-- Notes re TySynCtxt
-- We allow type synonyms that aren't types; e.g.  type List = []
--
-- If the RHS mentions tyvars that aren't in scope, we'll
-- quantify over them:
--      e.g.    type T = a->a
-- will become  type T = forall a. a->a
--
-- With gla-exts that's right, but for H98 we should complain.
-}


pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt Name
n Bool
_)  = String -> SDoc
text String
"the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (InfSigCtxt Name
n)    = String -> SDoc
text String
"the inferred type for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (RuleSigCtxt Name
n)   = String -> SDoc
text String
"the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
ExprSigCtxt       = String -> SDoc
text String
"an expression type signature"
pprUserTypeCtxt UserTypeCtxt
KindSigCtxt       = String -> SDoc
text String
"a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt Name
n) = String -> SDoc
text String
"a standalone kind signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
TypeAppCtxt       = String -> SDoc
text String
"a type argument"
pprUserTypeCtxt (ConArgCtxt Name
c)    = String -> SDoc
text String
"the type of the constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt (TySynCtxt Name
c)     = String -> SDoc
text String
"the RHS of the type synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
PatSigCtxt        = String -> SDoc
text String
"a pattern type signature"
pprUserTypeCtxt (ForSigCtxt Name
n)    = String -> SDoc
text String
"the foreign declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
DefaultDeclCtxt   = String -> SDoc
text String
"a type in a `default' declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
False) = String -> SDoc
text String
"an instance declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
True)  = String -> SDoc
text String
"a stand-alone deriving instance declaration"
pprUserTypeCtxt UserTypeCtxt
SpecInstCtxt      = String -> SDoc
text String
"a SPECIALISE instance pragma"
pprUserTypeCtxt UserTypeCtxt
GenSigCtxt        = String -> SDoc
text String
"a type expected by the context"
pprUserTypeCtxt (GhciCtxt {})     = String -> SDoc
text String
"a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt Name
c)   = String -> SDoc
text String
"the super-classes of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
SigmaCtxt         = String -> SDoc
text String
"the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt Name
tc)   = String -> SDoc
text String
"the context of the data type declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc)
pprUserTypeCtxt (PatSynCtxt Name
n)    = String -> SDoc
text String
"the signature for pattern synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (UserTypeCtxt
DerivClauseCtxt) = String -> SDoc
text String
"a `deriving' clause"
pprUserTypeCtxt (TyVarBndrKindCtxt Name
n) = String -> SDoc
text String
"the kind annotation on the type variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (DataKindCtxt Name
n)  = String -> SDoc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TySynKindCtxt Name
n) = String -> SDoc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TyFamResKindCtxt Name
n) = String -> SDoc
text String
"the result kind for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)

isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt Name
n Bool
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ConArgCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ForSigCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (PatSynCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe UserTypeCtxt
_                = Maybe Name
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
                SkolemInfo
*                                                                      *
************************************************************************
-}

-- SkolemInfo gives the origin of *given* constraints
--   a) type variables are skolemised
--   b) an implication constraint is generated
data SkolemInfo
  = SigSkol -- A skolem that is created by instantiating
            -- a programmer-supplied type signature
            -- Location of the binding site is on the TyVar
            -- See Note [SigSkol SkolemInfo]
       UserTypeCtxt        -- What sort of signature
       TcType              -- Original type signature (before skolemisation)
       [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar
                           -- to its instantiated version

  | SigTypeSkol UserTypeCtxt
                 -- like SigSkol, but when we're kind-checking the *type*
                 -- hence, we have less info

  | ForAllSkol  -- Bound by a user-written "forall".
       SDoc        -- Shows just the binders, used when reporting a bad telescope
                   -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint

  | DerivSkol Type      -- Bound by a 'deriving' clause;
                        -- the type is the instance we are trying to derive

  | InstSkol            -- Bound at an instance decl

  | FamInstSkol         -- Bound at a family instance decl
  | PatSkol             -- An existential type variable bound by a pattern for
      ConLike           -- a data constructor with an existential type.
      (HsMatchContext GhcRn)
             -- e.g.   data T = forall a. Eq a => MkT a
             --        f (MkT x) = ...
             -- The pattern MkT x will allocate an existential type
             -- variable for 'a'.

  | ArrowSkol           -- An arrow form (see GHC.Tc.Gen.Arrow)

  | IPSkol [HsIPName]   -- Binding site of an implicit parameter

  | RuleSkol RuleName   -- The LHS of a RULE

  | InferSkol [(Name,TcType)]
                        -- We have inferred a type for these (mutually-recursivive)
                        -- polymorphic Ids, and are now checking that their RHS
                        -- constraints are satisfied.

  | BracketSkol         -- Template Haskell bracket

  | UnifyForAllSkol     -- We are unifying two for-all types
       TcType           -- The instantiated type *inside* the forall

  | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour

  | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or
                        -- as any variable in a GADT datacon decl

  | ReifySkol           -- Bound during Template Haskell reification

  | QuantCtxtSkol       -- Quantified context, e.g.
                        --   f :: forall c. (forall a. c a => c [a]) => blah

  | RuntimeUnkSkol      -- Runtime skolem from the GHCi debugger      #14628

  | UnkSkol             -- Unhelpful info (until I improve it)

instance Outputable SkolemInfo where
  ppr :: SkolemInfo -> SDoc
ppr = SkolemInfo -> SDoc
pprSkolInfo

pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo :: SkolemInfo -> SDoc
pprSkolInfo (SigSkol UserTypeCtxt
cx TcType
ty [(Name, Id)]
_) = UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
cx TcType
ty
pprSkolInfo (SigTypeSkol UserTypeCtxt
cx)  = UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
cx
pprSkolInfo (ForAllSkol SDoc
tvs)  = String -> SDoc
text String
"an explicit forall" SDoc -> SDoc -> SDoc
<+> SDoc
tvs
pprSkolInfo (IPSkol [HsIPName]
ips)      = String -> SDoc
text String
"the implicit-parameter binding" SDoc -> SDoc -> SDoc
<> [HsIPName] -> SDoc
forall a. [a] -> SDoc
plural [HsIPName]
ips SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for"
                                 SDoc -> SDoc -> SDoc
<+> (HsIPName -> SDoc) -> [HsIPName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsIPName]
ips
pprSkolInfo (DerivSkol TcType
pred)  = String -> SDoc
text String
"the deriving clause for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred)
pprSkolInfo SkolemInfo
InstSkol          = String -> SDoc
text String
"the instance declaration"
pprSkolInfo SkolemInfo
FamInstSkol       = String -> SDoc
text String
"a family instance declaration"
pprSkolInfo SkolemInfo
BracketSkol       = String -> SDoc
text String
"a Template Haskell bracket"
pprSkolInfo (RuleSkol FastString
name)   = String -> SDoc
text String
"the RULE" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
pprRuleName FastString
name
pprSkolInfo SkolemInfo
ArrowSkol         = String -> SDoc
text String
"an arrow form"
pprSkolInfo (PatSkol ConLike
cl HsMatchContext GhcRn
mc)   = [SDoc] -> SDoc
sep [ ConLike -> SDoc
pprPatSkolInfo ConLike
cl
                                    , String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> HsMatchContext GhcRn -> SDoc
forall p.
(Outputable (IdP p), UnXRec p) =>
HsMatchContext p -> SDoc
pprMatchContext HsMatchContext GhcRn
mc ]
pprSkolInfo (InferSkol [(Name, TcType)]
ids)   = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"the inferred type" SDoc -> SDoc -> SDoc
<> [(Name, TcType)] -> SDoc
forall a. [a] -> SDoc
plural [(Name, TcType)]
ids SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of")
                                   Int
2 ([SDoc] -> SDoc
vcat [ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
                                           | (Name
name,TcType
ty) <- [(Name, TcType)]
ids ])
pprSkolInfo (UnifyForAllSkol TcType
ty) = String -> SDoc
text String
"the type" SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
pprSkolInfo (TyConSkol TyConFlavour
flav Name
name) = String -> SDoc
text String
"the" SDoc -> SDoc -> SDoc
<+> TyConFlavour -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
flav SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo (DataConSkol Name
name)= String -> SDoc
text String
"the data constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo SkolemInfo
ReifySkol         = String -> SDoc
text String
"the type being reified"

pprSkolInfo (QuantCtxtSkol {}) = String -> SDoc
text String
"a quantified context"
pprSkolInfo SkolemInfo
RuntimeUnkSkol     = String -> SDoc
text String
"Unknown type from GHCi runtime"

-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.
-- For Insts, these cases should not happen
pprSkolInfo SkolemInfo
UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"

pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
-- The type is already tidied
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
ctxt TcType
ty
  = case UserTypeCtxt
ctxt of
       FunSigCtxt Name
f Bool
_ -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"the type signature for:"
                              , Int -> SDoc -> SDoc
nest Int
2 (Name -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc Name
f SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
       PatSynCtxt {}  -> UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt  -- See Note [Skolem info for pattern synonyms]
       UserTypeCtxt
_              -> [SDoc] -> SDoc
vcat [ UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt SDoc -> SDoc -> SDoc
<> SDoc
colon
                              , Int -> SDoc -> SDoc
nest Int
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]

pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo (RealDataCon DataCon
dc)
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes (\Bool
show_linear_types ->
      [SDoc] -> SDoc
sep [ String -> SDoc
text String
"a pattern with constructor:"
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
<+> SDoc
dcolon
            SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
pprType (Bool -> DataCon -> TcType
dataConDisplayType Bool
show_linear_types DataCon
dc) SDoc -> SDoc -> SDoc
<> SDoc
comma ])
            -- pprType prints forall's regardless of -fprint-explicit-foralls
            -- which is what we want here, since we might be saying
            -- type variable 't' is bound by ...

pprPatSkolInfo (PatSynCon PatSyn
ps)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"a pattern with pattern synonym:"
        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps SDoc -> SDoc -> SDoc
<+> SDoc
dcolon
                   SDoc -> SDoc -> SDoc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
ps SDoc -> SDoc -> SDoc
<> SDoc
comma ]

{- Note [Skolem info for pattern synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For pattern synonym SkolemInfo we have
   SigSkol (PatSynCtxt p) ty _
but the type 'ty' is not very helpful.  The full pattern-synonym type
has the provided and required pieces, which it is inconvenient to
record and display here. So we simply don't display the type at all,
contenting ourselves with just the name of the pattern synonym, which
is fine.  We could do more, but it doesn't seem worth it.

Note [SigSkol SkolemInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we skolemise a type
   f :: forall a. Eq a => forall b. b -> a
Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated
      a' -> b' -> a.
But when, in an error message, we report that "b is a rigid type
variable bound by the type signature for f", we want to show the foralls
in the right place.  So we proceed as follows:

* In SigSkol we record
    - the original signature forall a. a -> forall b. b -> a
    - the instantiation mapping [a :-> a', b :-> b']

* Then when tidying in GHC.Tc.Utils.TcMType.tidySkolemInfo, we first tidy a' to
  whatever it tidies to, say a''; and then we walk over the type
  replacing the binder a by the tidied version a'', to give
       forall a''. Eq a'' => forall b''. b'' -> a''
  We need to do this under (=>) arrows, to match what topSkolemise
  does.

* Typically a'' will have a nice pretty name like "a", but the point is
  that the foral-bound variables of the signature we report line up with
  the instantiated skolems lying  around in other types.


************************************************************************
*                                                                      *
            CtOrigin
*                                                                      *
************************************************************************
-}

data CtOrigin
  = -- | A given constraint from a user-written type signature. The
    -- 'SkolemInfo' inside gives more information.
    GivenOrigin SkolemInfo

  -- The following are other origins for given constraints that cannot produce
  -- new skolems -- hence no SkolemInfo.

  -- | 'InstSCOrigin' is used for a Given constraint obtained by superclass selection
  -- from the context of an instance declaration.  E.g.
  --       instance @(Foo a, Bar a) => C [a]@ where ...
  -- When typechecking the instance decl itself, including producing evidence
  -- for the superclasses of @C@, the superclasses of @(Foo a)@ and @(Bar a)@ will
  -- have 'InstSCOrigin' origin.
  | InstSCOrigin ScDepth      -- ^ The number of superclass selections necessary to
                              -- get this constraint; see Note [Replacement vs keeping]
                              -- and Note [Use only the best local instance], both in
                              -- GHC.Tc.Solver.Interact
                 TypeSize     -- ^ If @(C ty1 .. tyn)@ is the largest class from
                              --    which we made a superclass selection in the chain,
                              --    then @TypeSize = sizeTypes [ty1, .., tyn]@
                              -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance

  -- | 'OtherSCOrigin' is used for a Given constraint obtained by superclass
  -- selection from a constraint /other than/ the context of an instance
  -- declaration. (For the latter we use 'InstSCOrigin'.)  E.g.
  --      f :: Foo a => blah
  --      f = e
  -- When typechecking body of 'f', the superclasses of the Given (Foo a)
  -- will have 'OtherSCOrigin'.
  -- Needed for Note [Replacement vs keeping] and
  -- Note [Use only the best local instance], both in GHC.Tc.Solver.Interact.
  | OtherSCOrigin ScDepth -- ^ The number of superclass selections necessary to
                          -- get this constraint
                  SkolemInfo   -- ^ Where the sub-class constraint arose from
                               -- (used only for printing)

  -- All the others are for *wanted* constraints

  | OccurrenceOf Name              -- Occurrence of an overloaded identifier
  | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector
  | AppOrigin                      -- An application of some kind

  | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for
                                   -- function or instance

  | TypeEqOrigin { CtOrigin -> TcType
uo_actual   :: TcType
                 , CtOrigin -> TcType
uo_expected :: TcType
                 , CtOrigin -> Maybe SDoc
uo_thing    :: Maybe SDoc
                       -- ^ The thing that has type "actual"
                 , CtOrigin -> Bool
uo_visible  :: Bool
                       -- ^ Is at least one of the three elements above visible?
                       -- (Errors from the polymorphic subsumption check are considered
                       -- visible.) Only used for prioritizing error messages.
                 }

  | KindEqOrigin
      TcType TcType             -- A kind equality arising from unifying these two types
      CtOrigin                  -- originally arising from this
      (Maybe TypeOrKind)        -- the level of the eq this arises from

  | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter
  | OverLabelOrigin FastString  -- Occurrence of an overloaded label

  | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal
  | NegateOrigin                        -- Occurrence of syntactic negation

  | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc
  | AssocFamPatOrigin   -- When matching the patterns of an associated
                        -- family instance with that of its parent class
  | SectionOrigin
  | HasFieldOrigin FastString
  | TupleOrigin         -- (..,..)
  | ExprSigOrigin       -- e :: ty
  | PatSigOrigin        -- p :: ty
  | PatOrigin           -- Instantiating a polytyped pattern at a constructor
  | ProvCtxtOrigin      -- The "provided" context of a pattern synonym signature
        (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in
                                 -- particular the name and the right-hand side
  | RecordUpdOrigin
  | ViewPatOrigin

  -- | 'ScOrigin' is used only for the Wanted constraints for the
  -- superclasses of an instance declaration.
  -- If the instance head is @C ty1 .. tyn@
  --    then @TypeSize = sizeTypes [ty1, .., tyn]@
  -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance
  | ScOrigin TypeSize

  | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to
                        -- standalone deriving).
  | DerivOriginDC DataCon Int Bool
      -- Checking constraints arising from this data con and field index. The
      -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if
      -- standalong deriving (with a wildcard constraint) is being used. This
      -- is used to inform error messages on how to recommended fixes (e.g., if
      -- the argument is True, then don't recommend "use standalone deriving",
      -- but rather "fill in the wildcard constraint yourself").
      -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer
  | DerivOriginCoerce Id Type Type Bool
                        -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from
                        -- `ty1` to `ty2`.
  | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for
                          -- constraints coming from a wildcard constraint,
                          -- e.g., deriving instance _ => Eq (Foo a)
                          -- See Note [Inferring the instance context]
                          -- in GHC.Tc.Deriv.Infer
  | DefaultOrigin       -- Typechecking a default decl
  | DoOrigin            -- Arising from a do expression
  | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in
                             -- a do expression
  | MCompOrigin         -- Arising from a monad comprehension
  | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a
                                -- monad comprehension
  | IfOrigin            -- Arising from an if statement
  | ProcOrigin          -- Arising from a proc expression
  | AnnOrigin           -- An annotation

  | FunDepOrigin1       -- A functional dependency from combining
        PredType CtOrigin RealSrcSpan      -- This constraint arising from ...
        PredType CtOrigin RealSrcSpan      -- and this constraint arising from ...

  | FunDepOrigin2       -- A functional dependency from combining
        PredType CtOrigin   -- This constraint arising from ...
        PredType SrcSpan    -- and this top-level instance
        -- We only need a CtOrigin on the first, because the location
        -- is pinned on the entire error message

  | ExprHoleOrigin OccName   -- from an expression hole
  | TypeHoleOrigin OccName   -- from a type hole (partial type signature)
  | PatCheckOrigin      -- normalisation of a type during pattern-match checking
  | ListOrigin          -- An overloaded list
  | BracketOrigin       -- An overloaded quotation bracket
  | StaticOrigin        -- A static form
  | Shouldn'tHappenOrigin String
                            -- the user should never see this one,
                            -- unless ImpredicativeTypes is on, where all
                            -- bets are off
  | InstProvidedOrigin Module ClsInst
        -- Skolem variable arose when we were testing if an instance
        -- is solvable or not.
  | NonLinearPatternOrigin
  | UsageEnvironmentOf Name

  | CycleBreakerOrigin
      CtOrigin   -- origin of the original constraint
      -- See Detail (7) of Note [Type equality cycles] in GHC.Tc.Solver.Canonical

-- | The number of superclass selections needed to get this Given.
-- If @d :: C ty@   has @ScDepth=2@, then the evidence @d@ will look
-- like @sc_sel (sc_sel dg)@, where @dg@ is a Given.
type ScDepth = Int

-- An origin is visible if the place where the constraint arises is manifest
-- in user code. Currently, all origins are visible except for invisible
-- TypeEqOrigins. This is used when choosing which error of
-- several to report
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin (TypeEqOrigin { uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis }) = Bool
vis
isVisibleOrigin (KindEqOrigin TcType
_ TcType
_ CtOrigin
sub_orig Maybe TypeOrKind
_)       = CtOrigin -> Bool
isVisibleOrigin CtOrigin
sub_orig
isVisibleOrigin CtOrigin
_                                   = Bool
True

-- Converts a visible origin to an invisible one, if possible. Currently,
-- this works only for TypeEqOrigin
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin orig :: CtOrigin
orig@(TypeEqOrigin {}) = CtOrigin
orig { uo_visible :: Bool
uo_visible = Bool
False }
toInvisibleOrigin CtOrigin
orig                   = CtOrigin
orig

isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin (GivenOrigin {})              = Bool
True
isGivenOrigin (InstSCOrigin {})             = Bool
True
isGivenOrigin (OtherSCOrigin {})            = Bool
True
isGivenOrigin (FunDepOrigin1 TcType
_ CtOrigin
o1 RealSrcSpan
_ TcType
_ CtOrigin
o2 RealSrcSpan
_) = CtOrigin -> Bool
isGivenOrigin CtOrigin
o1 Bool -> Bool -> Bool
&& CtOrigin -> Bool
isGivenOrigin CtOrigin
o2
isGivenOrigin (FunDepOrigin2 TcType
_ CtOrigin
o1 TcType
_ SrcSpan
_)      = CtOrigin -> Bool
isGivenOrigin CtOrigin
o1
isGivenOrigin (CycleBreakerOrigin CtOrigin
o)        = CtOrigin -> Bool
isGivenOrigin CtOrigin
o
isGivenOrigin CtOrigin
_                             = Bool
False

instance Outputable CtOrigin where
  ppr :: CtOrigin -> SDoc
ppr = CtOrigin -> SDoc
pprCtOrigin

ctoHerald :: SDoc
ctoHerald :: SDoc
ctoHerald = String -> SDoc
text String
"arising from"

-- | Extract a suitable CtOrigin from a HsExpr
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin (L SrcSpanAnnA
_ HsExpr GhcRn
e) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e

exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
name)) = Name -> CtOrigin
OccurrenceOf Name
name
exprCtOrigin (HsGetField XGetField GhcRn
_ LHsExpr GhcRn
_ (L SrcSpan
_ HsFieldLabel GhcRn
f)) = FastString -> CtOrigin
HasFieldOrigin (GenLocated SrcSpan FastString -> FastString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan FastString -> FastString)
-> GenLocated SrcSpan FastString -> FastString
forall a b. (a -> b) -> a -> b
$ HsFieldLabel GhcRn -> GenLocated SrcSpan FastString
forall p. HsFieldLabel p -> GenLocated SrcSpan FastString
hflLabel HsFieldLabel GhcRn
f)
exprCtOrigin (HsUnboundVar {})    = String -> CtOrigin
Shouldn'tHappenOrigin String
"unbound variable"
exprCtOrigin (HsConLikeOut {})    = String -> CtOrigin
forall a. String -> a
panic String
"exprCtOrigin HsConLikeOut"
exprCtOrigin (HsRecFld XRecFld GhcRn
_ AmbiguousFieldOcc GhcRn
f)       = RdrName -> CtOrigin
OccurrenceOfRecSel (AmbiguousFieldOcc GhcRn -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc AmbiguousFieldOcc GhcRn
f)
exprCtOrigin (HsOverLabel XOverLabel GhcRn
_ FastString
l)    = FastString -> CtOrigin
OverLabelOrigin FastString
l
exprCtOrigin (ExplicitList {})    = CtOrigin
ListOrigin
exprCtOrigin (HsIPVar XIPVar GhcRn
_ HsIPName
ip)       = HsIPName -> CtOrigin
IPOccOrigin HsIPName
ip
exprCtOrigin (HsOverLit XOverLitE GhcRn
_ HsOverLit GhcRn
lit)    = HsOverLit GhcRn -> CtOrigin
LiteralOrigin HsOverLit GhcRn
lit
exprCtOrigin (HsLit {})           = String -> CtOrigin
Shouldn'tHappenOrigin String
"concrete literal"
exprCtOrigin (HsLam XLam GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches)    = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsLamCase XLamCase GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
ms)     = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
ms
exprCtOrigin (HsApp XApp GhcRn
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
_)       = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e1 LHsWcType (NoGhcTc GhcRn)
_)   = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (OpApp XOpApp GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
op LHsExpr GhcRn
_)     = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
op
exprCtOrigin (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_)       = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsPar XPar GhcRn
_ LHsExpr GhcRn
e)          = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsProjection XProjection GhcRn
_ NonEmpty (GenLocated SrcSpan (HsFieldLabel GhcRn))
_)   = CtOrigin
SectionOrigin
exprCtOrigin (SectionL XSectionL GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_)     = CtOrigin
SectionOrigin
exprCtOrigin (SectionR XSectionR GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_)     = CtOrigin
SectionOrigin
exprCtOrigin (ExplicitTuple {})   = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit tuple"
exprCtOrigin ExplicitSum{}        = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit sum"
exprCtOrigin (HsCase XCase GhcRn
_ LHsExpr GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsIf {})           = String -> CtOrigin
Shouldn'tHappenOrigin String
"if expression"
exprCtOrigin (HsMultiIf XMultiIf GhcRn
_ [LGRHS GhcRn (LHsExpr GhcRn)]
rhs)   = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
rhs
exprCtOrigin (HsLet XLet GhcRn
_ HsLocalBinds GhcRn
_ LHsExpr GhcRn
e)       = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsDo {})           = CtOrigin
DoOrigin
exprCtOrigin (RecordCon {})      = String -> CtOrigin
Shouldn'tHappenOrigin String
"record construction"
exprCtOrigin (RecordUpd {})      = CtOrigin
RecordUpdOrigin
exprCtOrigin (ExprWithTySig {})  = CtOrigin
ExprSigOrigin
exprCtOrigin (ArithSeq {})       = String -> CtOrigin
Shouldn'tHappenOrigin String
"arithmetic sequence"
exprCtOrigin (HsPragE XPragE GhcRn
_ HsPragE GhcRn
_ LHsExpr GhcRn
e)     = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsBracket {})      = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH bracket"
exprCtOrigin (HsRnBracketOut {})= String -> CtOrigin
Shouldn'tHappenOrigin String
"HsRnBracketOut"
exprCtOrigin (HsTcBracketOut {})= String -> CtOrigin
forall a. String -> a
panic String
"exprCtOrigin HsTcBracketOut"
exprCtOrigin (HsSpliceE {})      = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH splice"
exprCtOrigin (HsProc {})         = String -> CtOrigin
Shouldn'tHappenOrigin String
"proc"
exprCtOrigin (HsStatic {})       = String -> CtOrigin
Shouldn'tHappenOrigin String
"static expression"
exprCtOrigin (HsTick XTick GhcRn
_ CoreTickish
_ LHsExpr GhcRn
e)           = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsBinTick XBinTick GhcRn
_ Int
_ Int
_ LHsExpr GhcRn
e)      = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (XExpr (HsExpanded HsExpr GhcRn
a HsExpr GhcRn
_)) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
a

-- | Extract a suitable CtOrigin from a MatchGroup
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts })
  | L SrcSpanAnnL
_ [L SrcSpanAnnA
_ Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match] <- XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts
  , Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhss } <- Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match
  = GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
GRHSs GhcRn (LHsExpr GhcRn)
grhss

  | Bool
otherwise
  = String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way match"

-- | Extract a suitable CtOrigin from guarded RHSs
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin (GRHSs { grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs = [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss }) = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss

-- | Extract a suitable CtOrigin from a list of guarded RHSs
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [L SrcSpan
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [GuardLStmt GhcRn]
_ (L SrcSpanAnnA
_ HsExpr GhcRn
e))] = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
_ = String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way GRHS"

pprCtOrigin :: CtOrigin -> SDoc
-- "arising from ..."
-- Not an instance of Outputable because of the "arising from" prefix
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin SkolemInfo
sk)     = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfo
sk
pprCtOrigin (InstSCOrigin {})    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfo -> SDoc
pprSkolInfo SkolemInfo
InstSkol   -- keep output in sync
pprCtOrigin (OtherSCOrigin Int
_ SkolemInfo
si) = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfo -> SDoc
pprSkolInfo SkolemInfo
si

pprCtOrigin (SpecPragOrigin UserTypeCtxt
ctxt)
  = case UserTypeCtxt
ctxt of
       FunSigCtxt Name
n Bool
_ -> String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
       UserTypeCtxt
SpecInstCtxt   -> String -> SDoc
text String
"a SPECIALISE INSTANCE pragma"
       UserTypeCtxt
_              -> String -> SDoc
text String
"a SPECIALISE pragma"  -- Never happens I think

pprCtOrigin (FunDepOrigin1 TcType
pred1 CtOrigin
orig1 RealSrcSpan
loc1 TcType
pred2 CtOrigin
orig2 RealSrcSpan
loc2)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a functional dependency between constraints:")
       Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
               , SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])

pprCtOrigin (FunDepOrigin2 TcType
pred1 CtOrigin
orig1 TcType
pred2 SrcSpan
loc2)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a functional dependency between:")
       Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"constraint" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1))
                    Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 )
               , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"instance" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2))
                    Int
2 (String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc2) ])

pprCtOrigin CtOrigin
AssocFamPatOrigin
  = String -> SDoc
text String
"when matching a family LHS with its class instance head"

pprCtOrigin (TypeEqOrigin { uo_actual :: CtOrigin -> TcType
uo_actual = TcType
t1, uo_expected :: CtOrigin -> TcType
uo_expected =  TcType
t2, uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis })
  = String -> SDoc
text String
"a type equality" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
vis) SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2]

pprCtOrigin (KindEqOrigin TcType
t1 TcType
t2 CtOrigin
_ Maybe TypeOrKind
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a kind equality arising from")
       Int
2 ([SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])

pprCtOrigin (DerivOriginDC DataCon
dc Int
n Bool
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
n
          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"field of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc))
       Int
2 (SDoc -> SDoc
parens (String -> SDoc
text String
"type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Scaled TcType -> TcType
forall a. Scaled a -> a
scaledThing Scaled TcType
ty))))
  where
    ty :: Scaled TcType
ty = DataCon -> [Scaled TcType]
dataConOrigArgTys DataCon
dc [Scaled TcType] -> Int -> Scaled TcType
forall a. [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

pprCtOrigin (DerivOriginCoerce Id
meth TcType
ty1 TcType
ty2 Bool
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the coercion of the method" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
meth))
       Int
2 ([SDoc] -> SDoc
sep [ String -> SDoc
text String
"from type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty1)
              , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"to type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty2) ])

pprCtOrigin (DoPatOrigin LPat GhcRn
pat)
    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a do statement"
      SDoc -> SDoc -> SDoc
$$
      String -> SDoc
text String
"with the failable pattern" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (Pat GhcRn)
LPat GhcRn
pat)

pprCtOrigin (MCompPatOrigin LPat GhcRn
pat)
    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [ String -> SDoc
text String
"the failable pattern"
           , SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenLocated SrcSpanAnnA (Pat GhcRn)
LPat GhcRn
pat)
           , String -> SDoc
text String
"in a statement in a monad comprehension" ]

pprCtOrigin (Shouldn'tHappenOrigin String
note)
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocImpredicativeTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
      Bool
True  -> String -> SDoc
text String
"a situation created by impredicative types"
      Bool
False -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"<< This should not appear in error messages. If you see this"
                    , String -> SDoc
text String
"in an error message, please report a bug mentioning"
                        SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
note) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at"
                    , String -> SDoc
text String
"https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>"
                    ]

pprCtOrigin (ProvCtxtOrigin PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = (L SrcSpanAnnN
_ Name
name) })
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the \"provided\" constraints claimed by")
       Int
2 (String -> SDoc
text String
"the signature of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name))

pprCtOrigin (InstProvidedOrigin Module
mod ClsInst
cls_inst)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"arising when attempting to show that"
         , ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClsInst
cls_inst
         , String -> SDoc
text String
"is provided by" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)]

pprCtOrigin (CycleBreakerOrigin CtOrigin
orig)
  = CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig

pprCtOrigin CtOrigin
simple_origin
  = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> CtOrigin -> SDoc
pprCtO CtOrigin
simple_origin

-- | Short one-liners
pprCtO :: CtOrigin -> SDoc
pprCtO :: CtOrigin -> SDoc
pprCtO (OccurrenceOf Name
name)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)]
pprCtO (OccurrenceOfRecSel RdrName
name) = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]
pprCtO CtOrigin
AppOrigin             = String -> SDoc
text String
"an application"
pprCtO (IPOccOrigin HsIPName
name)    = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of implicit parameter", SDoc -> SDoc
quotes (HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
name)]
pprCtO (OverLabelOrigin FastString
l)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the overloaded label"
                                    ,SDoc -> SDoc
quotes (Char -> SDoc
char Char
'#' SDoc -> SDoc -> SDoc
<> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
l)]
pprCtO CtOrigin
RecordUpdOrigin       = String -> SDoc
text String
"a record update"
pprCtO CtOrigin
ExprSigOrigin         = String -> SDoc
text String
"an expression type signature"
pprCtO CtOrigin
PatSigOrigin          = String -> SDoc
text String
"a pattern type signature"
pprCtO CtOrigin
PatOrigin             = String -> SDoc
text String
"a pattern"
pprCtO CtOrigin
ViewPatOrigin         = String -> SDoc
text String
"a view pattern"
pprCtO CtOrigin
IfOrigin              = String -> SDoc
text String
"an if expression"
pprCtO (LiteralOrigin HsOverLit GhcRn
lit)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the literal", SDoc -> SDoc
quotes (HsOverLit GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcRn
lit)]
pprCtO (ArithSeqOrigin ArithSeqInfo GhcRn
seq)  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the arithmetic sequence", SDoc -> SDoc
quotes (ArithSeqInfo GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArithSeqInfo GhcRn
seq)]
pprCtO CtOrigin
SectionOrigin         = String -> SDoc
text String
"an operator section"
pprCtO (HasFieldOrigin FastString
f)    = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"selecting the field", SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
f)]
pprCtO CtOrigin
AssocFamPatOrigin     = String -> SDoc
text String
"the LHS of a family instance"
pprCtO CtOrigin
TupleOrigin           = String -> SDoc
text String
"a tuple"
pprCtO CtOrigin
NegateOrigin          = String -> SDoc
text String
"a use of syntactic negation"
pprCtO (ScOrigin TypeSize
n)          = String -> SDoc
text String
"the superclasses of an instance declaration"
                               SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (SDoc -> SDoc
parens (TypeSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeSize
n))
pprCtO CtOrigin
DerivClauseOrigin     = String -> SDoc
text String
"the 'deriving' clause of a data type declaration"
pprCtO CtOrigin
StandAloneDerivOrigin = String -> SDoc
text String
"a 'deriving' declaration"
pprCtO CtOrigin
DefaultOrigin         = String -> SDoc
text String
"a 'default' declaration"
pprCtO CtOrigin
DoOrigin              = String -> SDoc
text String
"a do statement"
pprCtO CtOrigin
MCompOrigin           = String -> SDoc
text String
"a statement in a monad comprehension"
pprCtO CtOrigin
ProcOrigin            = String -> SDoc
text String
"a proc expression"
pprCtO CtOrigin
AnnOrigin             = String -> SDoc
text String
"an annotation"
pprCtO (ExprHoleOrigin OccName
occ)  = String -> SDoc
text String
"a use of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
pprCtO (TypeHoleOrigin OccName
occ)  = String -> SDoc
text String
"a use of wildcard" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
pprCtO CtOrigin
PatCheckOrigin        = String -> SDoc
text String
"a pattern-match completeness check"
pprCtO CtOrigin
ListOrigin            = String -> SDoc
text String
"an overloaded list"
pprCtO CtOrigin
StaticOrigin          = String -> SDoc
text String
"a static form"
pprCtO CtOrigin
NonLinearPatternOrigin = String -> SDoc
text String
"a non-linear pattern"
pprCtO (UsageEnvironmentOf Name
x) = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"multiplicity of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
x)]
pprCtO CtOrigin
BracketOrigin         = String -> SDoc
text String
"a quotation bracket"
pprCtO CtOrigin
_                     = String -> SDoc
forall a. String -> a
panic String
"pprCtOrigin"