    {-# 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (forall a. Outputable a => a -> SDoc
    ppr Name
    n)

    isSigMaybe :: UserTypeCtxt -> Maybe Name
    isSigMaybe :: UserTypeCtxt -> Maybe Name
    isSigMaybe (FunSigCtxt Name
    n Bool
    _) = forall a. a -> Maybe a
    Just Name
    n
    isSigMaybe (ConArgCtxt Name
    n)   = forall a. a -> Maybe a
    Just Name
    n
    isSigMaybe (ForSigCtxt Name
    n)   = forall a. a -> Maybe a
    Just Name
    n
    isSigMaybe (PatSynCtxt Name
    n)   = forall a. a -> Maybe a
    Just Name
    n
    isSigMaybe UserTypeCtxt
    _                = 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
    <> forall a. [a] -> SDoc
    plural [HsIPName]
    ips SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "for"
                                     SDoc -> SDoc -> SDoc
    <+> forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas 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 (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
    <+> 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
    <> forall a. [a] -> SDoc
    plural [(Name, TcType)]
    ids SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "of")
                                       Int
    2 ([SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr Name
    name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> 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
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    ty
    pprSkolInfo (TyConSkol TyConFlavour
    flav Name
    name) = String -> SDoc
    text String
    "the" SDoc -> SDoc -> 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 (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 (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 (forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc Name
    f SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> 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 (forall a. Outputable a => a -> SDoc
    ppr TcType
    ty) ]

    pprPatSkolInfo :: ConLike -> SDoc
    pprPatSkolInfo :: ConLike -> SDoc
    pprPatSkolInfo (RealDataCon DataCon
    dc)
      = 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 forall a b. (a -> b) -> a -> b
    $ 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 forall a b. (a -> b) -> a -> b
    $ 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 (Maybe 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

      | InstanceSigOrigin   -- from the sub-type check of an InstanceSig
          Name   -- the method name
          Type   -- the instance-sig type
          Type   -- the instantiated type of the method
      | AmbiguityCheckOrigin UserTypeCtxt
      | GhcBug20076

    -- | 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 (forall l e. GenLocated l e -> e
    unLoc forall a b. (a -> b) -> a -> b
    $ forall p. HsFieldLabel p -> Located FastString
    hflLabel HsFieldLabel GhcRn
    f)
    exprCtOrigin (HsUnboundVar {})    = String -> CtOrigin
    Shouldn'tHappenOrigin String
    "unbound variable"
    exprCtOrigin (HsConLikeOut {})    = forall a. String -> a
    panic String
    "exprCtOrigin HsConLikeOut"
    exprCtOrigin (HsRecFld XRecFld GhcRn
    _ AmbiguousFieldOcc GhcRn
    f)       = RdrName -> CtOrigin
    OccurrenceOfRecSel (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 {})= 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

      | 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
    <+> 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 (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 (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
    <+> forall a. Outputable a => a -> SDoc
    ppr RealSrcSpan
    loc1)
                   , SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (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
    <+> 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 (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 (forall a. Outputable a => a -> SDoc
    ppr TcType
    pred2))
                        Int
    2 (String -> SDoc
    text String
    "at" SDoc -> SDoc -> 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 (forall a. Outputable a => a -> SDoc
    ppr Bool
    vis) SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    sep [forall a. Outputable a => a -> SDoc
    ppr TcType
    t1, Char -> SDoc
    char Char
    '~', 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 [forall a. Outputable a => a -> SDoc
    ppr TcType
    t1, Char -> SDoc
    char Char
    '~', 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 (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 (forall a. Outputable a => a -> SDoc
    ppr (forall a. Scaled a -> a
    scaledThing Scaled TcType
    ty))))
      where
        ty :: Scaled TcType
    ty = DataCon -> [Scaled TcType]
    dataConOrigArgTys DataCon
    dc forall a. [a] -> Int -> a
    !! (Int
    nforall 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 (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 (forall a. Outputable a => a -> SDoc
    ppr TcType
    ty1)
                  , Int -> SDoc -> SDoc
    nest Int
    2 forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "to type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (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 (forall a. Outputable a => a -> SDoc
    ppr 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 (forall a. Outputable a => a -> SDoc
    ppr LPat GhcRn
    pat)
               , String -> SDoc
    text String
    "in a statement in a monad comprehension" ]

    pprCtOrigin (Shouldn'tHappenOrigin String
    note)
      = forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocImpredicativeTypes 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 (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"
             , forall a. Outputable a => a -> SDoc
    ppr ClsInst
    cls_inst
             , String -> SDoc
    text String
    "is provided by" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Module
    mod)]

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

    pprCtOrigin (InstanceSigOrigin Name
    method_name TcType
    sig_type TcType
    orig_method_type)
      = [SDoc] -> SDoc
    vcat [ SDoc
    ctoHerald SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "the check that an instance signature is more general"
             , String -> SDoc
    text String
    "than the type of the method (instantiated for this instance)"
             , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "instance signature:")
                  Int
    2 (forall a. Outputable a => a -> SDoc
    ppr Name
    method_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcType
    sig_type)
             , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "instantiated method type:")
                  Int
    2 (forall a. Outputable a => a -> SDoc
    ppr TcType
    orig_method_type) ]

    pprCtOrigin (AmbiguityCheckOrigin UserTypeCtxt
    ctxt)
      = SDoc
    ctoHerald SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "a type ambiguity check for" SDoc -> SDoc -> SDoc
    $$
        UserTypeCtxt -> SDoc
    pprUserTypeCtxt UserTypeCtxt
    ctxt

    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 (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 (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 (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
    <> 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 (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 (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 (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 (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 Maybe OccName
    Nothing)  = String -> SDoc
    text String
    "an expression hole"
    pprCtO (ExprHoleOrigin (Just OccName
    occ))  = String -> SDoc
    text String
    "a use of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (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 (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 (forall a. Outputable a => a -> SDoc
    ppr Name
    x)]
    pprCtO CtOrigin
    BracketOrigin         = String -> SDoc
    text String
    "a quotation bracket"
    pprCtO (InstanceSigOrigin {})  = String -> SDoc
    text String
    "a type signature in an instance"
    pprCtO (AmbiguityCheckOrigin {}) = String -> SDoc
    text String
    "a type ambiguity check"
    pprCtO CtOrigin
    GhcBug20076           = String -> SDoc
    text String
    "GHC Bug #20076"
    pprCtO CtOrigin
    _                     = forall a. String -> a
    panic String
    "pprCtOrigin"