    {-
    (c) The University of Glasgow 2006-2012
    (c) The GRASP Project, Glasgow University, 1992-2002

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}

    module GHC.Tc.Gen.Sig(
           TcSigInfo(..),
           TcIdSigInfo(..), TcIdSigInst,
           TcPatSynInfo(..),
           TcSigFun,

           isPartialSig, hasCompleteSig, tcIdSigName, tcSigInfoName,
           completeSigPolyId_maybe, isCompleteHsSig,

           tcTySigs, tcUserTypeSig, completeSigFromId,
           tcInstSig,

           TcPragEnv, emptyPragEnv, lookupPragEnv, extendPragEnv,
           mkPragEnv, tcSpecPrags, tcSpecWrapper, tcImpPrags, addInlinePrags
       ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Hs
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Types
    import GHC.Tc.Solver( pushLevelAndSolveEqualitiesX, reportUnsolvedEqualities )
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Zonk
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Validity ( checkValidType )
    import GHC.Tc.Utils.Unify( tcSkolemise, unifyType )
    import GHC.Tc.Utils.Instantiate( topInstantiate, tcInstTypeBndrs )
    import GHC.Tc.Utils.Env( tcLookupId )
    import GHC.Tc.Types.Evidence( HsWrapper, (<.>) )
    import GHC.Core( hasSomeUnfolding )
    import GHC.Core.Type ( mkTyVarBinders )
    import GHC.Core.Multiplicity

    import GHC.Driver.Session
    import GHC.Driver.Backend
    import GHC.Driver.Ppr
    import GHC.Types.Var ( TyVar, Specificity(..), tyVarKind, binderVars )
    import GHC.Types.Id  ( Id, idName, idType, setInlinePragma
                         , mkLocalId, realIdUnfolding )
    import GHC.Builtin.Names( mkUnboundName )
    import GHC.Types.Basic
    import GHC.Unit.Module( getModule )
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc as Utils ( singleton )
    import GHC.Data.Maybe( orElse )
    import Data.Maybe( mapMaybe )
    import Control.Monad( unless )

    {- -------------------------------------------------------------
              Note [Overview of type signatures]
    ----------------------------------------------------------------
    Type signatures, including partial signatures, are jolly tricky,
    especially on value bindings.  Here's an overview.

        f :: forall a. [a] -> [a]
        g :: forall b. _ -> b

        f = ...g...
        g = ...f...

    * HsSyn: a signature in a binding starts off as a TypeSig, in
      type HsBinds.Sig

    * When starting a mutually recursive group, like f/g above, we
      call tcTySig on each signature in the group.

    * tcTySig: Sig -> TcIdSigInfo
      - For a /complete/ signature, like 'f' above, tcTySig kind-checks
        the HsType, producing a Type, and wraps it in a CompleteSig, and
        extend the type environment with this polymorphic 'f'.

      - For a /partial/signature, like 'g' above, tcTySig does nothing
        Instead it just wraps the pieces in a PartialSig, to be handled
        later.

    * tcInstSig: TcIdSigInfo -> TcIdSigInst
      In tcMonoBinds, when looking at an individual binding, we use
      tcInstSig to instantiate the signature forall's in the signature,
      and attribute that instantiated (monomorphic) type to the
      binder.  You can see this in GHC.Tc.Gen.Bind.tcLhsId.

      The instantiation does the obvious thing for complete signatures,
      but for /partial/ signatures it starts from the HsSyn, so it
      has to kind-check it etc: tcHsPartialSigType.  It's convenient
      to do this at the same time as instantiation, because we can
      make the wildcards into unification variables right away, raather
      than somehow quantifying over them.  And the "TcLevel" of those
      unification variables is correct because we are in tcMonoBinds.

    Note [Binding scoped type variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The type variables *brought into lexical scope* by a type signature
    may be a subset of the *quantified type variables* of the signatures,
    for two reasons:

    * With kind polymorphism a signature like
        f :: forall f a. f a -> f a
      may actually give rise to
        f :: forall k. forall (f::k -> *) (a:k). f a -> f a
      So the sig_tvs will be [k,f,a], but only f,a are scoped.
      NB: the scoped ones are not necessarily the *initial* ones!

    * Even aside from kind polymorphism, there may be more instantiated
      type variables than lexically-scoped ones.  For example:
            type T a = forall b. b -> (a,b)
            f :: forall c. T c
      Here, the signature for f will have one scoped type variable, c,
      but two instantiated type variables, c' and b'.

    However, all of this only applies to the renamer.  The typechecker
    just puts all of them into the type environment; any lexical-scope
    errors were dealt with by the renamer.

    -}

    {- *********************************************************************
    *                                                                      *
                 Utility functions for TcSigInfo
    *                                                                      *
    ********************************************************************* -}

    tcIdSigName :: TcIdSigInfo -> Name
    tcIdSigName :: TcIdSigInfo -> Name
    tcIdSigName (CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr = TcId
    id }) = TcId -> Name
    idName TcId
    id
    tcIdSigName (PartialSig { psig_name :: TcIdSigInfo -> Name
    psig_name = Name
    n })  = Name
    n

    tcSigInfoName :: TcSigInfo -> Name
    tcSigInfoName :: TcSigInfo -> Name
    tcSigInfoName (TcIdSig     TcIdSigInfo
    idsi) = TcIdSigInfo -> Name
    tcIdSigName TcIdSigInfo
    idsi
    tcSigInfoName (TcPatSynSig TcPatSynInfo
    tpsi) = TcPatSynInfo -> Name
    patsig_name TcPatSynInfo
    tpsi

    completeSigPolyId_maybe :: TcSigInfo -> Maybe TcId
    completeSigPolyId_maybe :: TcSigInfo -> Maybe TcId
    completeSigPolyId_maybe TcSigInfo
    sig
      | TcIdSig TcIdSigInfo
    sig_info <- TcSigInfo
    sig
      , CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr = TcId
    id } <- TcIdSigInfo
    sig_info = TcId -> Maybe TcId
    forall a. a -> Maybe a
    Just TcId
    id
      | Bool
    otherwise                                 = Maybe TcId
    forall a. Maybe a
    Nothing

    {- *********************************************************************
    *                                                                      *
                   Typechecking user signatures
    *                                                                      *
    ********************************************************************* -}

    tcTySigs :: [LSig GhcRn] -> TcM ([TcId], TcSigFun)
    tcTySigs :: [LSig GhcRn] -> TcM ([TcId], TcSigFun)
    tcTySigs [LSig GhcRn]
    hs_sigs
      = TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun)
    forall r. TcM r -> TcM r
    checkNoErrs (TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun))
    -> TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun)
    forall a b. (a -> b) -> a -> b
    $
        do { -- Fail if any of the signatures is duff
             -- Hence mapAndReportM
             -- See Note [Fail eagerly on bad signatures]
             [[TcSigInfo]]
    ty_sigs_s <- (GenLocated SrcSpanAnnA (Sig GhcRn) -> TcRn [TcSigInfo])
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> TcRn [[TcSigInfo]]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndReportM GenLocated SrcSpanAnnA (Sig GhcRn) -> TcRn [TcSigInfo]
    LSig GhcRn -> TcRn [TcSigInfo]
    tcTySig [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    hs_sigs

           ; let ty_sigs :: [TcSigInfo]
    ty_sigs = [[TcSigInfo]] -> [TcSigInfo]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[TcSigInfo]]
    ty_sigs_s
                 poly_ids :: [TcId]
    poly_ids = (TcSigInfo -> Maybe TcId) -> [TcSigInfo] -> [TcId]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TcSigInfo -> Maybe TcId
    completeSigPolyId_maybe [TcSigInfo]
    ty_sigs
                            -- The returned [TcId] are the ones for which we have
                            -- a complete type signature.
                            -- See Note [Complete and partial type signatures]
                 env :: NameEnv TcSigInfo
    env = [(Name, TcSigInfo)] -> NameEnv TcSigInfo
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(TcSigInfo -> Name
    tcSigInfoName TcSigInfo
    sig, TcSigInfo
    sig) | TcSigInfo
    sig <- [TcSigInfo]
    ty_sigs]

           ; ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TcId]
    poly_ids, NameEnv TcSigInfo -> TcSigFun
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv TcSigInfo
    env) }

    tcTySig :: LSig GhcRn -> TcM [TcSigInfo]
    tcTySig :: LSig GhcRn -> TcRn [TcSigInfo]
    tcTySig (L SrcSpanAnnA
    _ (IdSig XIdSig GhcRn
    _ TcId
    id))
      = do { let ctxt :: UserTypeCtxt
    ctxt = Name -> Bool -> UserTypeCtxt
    FunSigCtxt (TcId -> Name
    idName TcId
    id) Bool
    False
                        -- False: do not report redundant constraints
                        -- The user has no control over the signature!
                 sig :: TcIdSigInfo
    sig = UserTypeCtxt -> TcId -> TcIdSigInfo
    completeSigFromId UserTypeCtxt
    ctxt TcId
    id
           ; [TcSigInfo] -> TcRn [TcSigInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [TcIdSigInfo -> TcSigInfo
    TcIdSig TcIdSigInfo
    sig] }

    tcTySig (L SrcSpanAnnA
    loc (TypeSig XTypeSig GhcRn
    _ [LIdP GhcRn]
    names LHsSigWcType GhcRn
    sig_ty))
      = SrcSpanAnnA -> TcRn [TcSigInfo] -> TcRn [TcSigInfo]
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn [TcSigInfo] -> TcRn [TcSigInfo])
    -> TcRn [TcSigInfo] -> TcRn [TcSigInfo]
    forall a b. (a -> b) -> a -> b
    $
        do { [TcIdSigInfo]
    sigs <- [IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo]
    -> IOEnv (Env TcGblEnv TcLclEnv) [TcIdSigInfo]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [ SrcSpan
    -> LHsSigWcType GhcRn
    -> Maybe Name
    -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo
    tcUserTypeSig (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) LHsSigWcType GhcRn
    sig_ty (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    name)
                              | L SrcSpanAnnN
    _ Name
    name <- [GenLocated SrcSpanAnnN Name]
    [LIdP GhcRn]
    names ]
           ; [TcSigInfo] -> TcRn [TcSigInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TcIdSigInfo -> TcSigInfo) -> [TcIdSigInfo] -> [TcSigInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map TcIdSigInfo -> TcSigInfo
    TcIdSig [TcIdSigInfo]
    sigs) }

    tcTySig (L SrcSpanAnnA
    loc (PatSynSig XPatSynSig GhcRn
    _ [LIdP GhcRn]
    names LHsSigType GhcRn
    sig_ty))
      = SrcSpanAnnA -> TcRn [TcSigInfo] -> TcRn [TcSigInfo]
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn [TcSigInfo] -> TcRn [TcSigInfo])
    -> TcRn [TcSigInfo] -> TcRn [TcSigInfo]
    forall a b. (a -> b) -> a -> b
    $
        do { [TcPatSynInfo]
    tpsigs <- [IOEnv (Env TcGblEnv TcLclEnv) TcPatSynInfo]
    -> IOEnv (Env TcGblEnv TcLclEnv) [TcPatSynInfo]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [ Name
    -> LHsSigType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) TcPatSynInfo
    tcPatSynSig Name
    name LHsSigType GhcRn
    sig_ty
                                | L SrcSpanAnnN
    _ Name
    name <- [GenLocated SrcSpanAnnN Name]
    [LIdP GhcRn]
    names ]
           ; [TcSigInfo] -> TcRn [TcSigInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TcPatSynInfo -> TcSigInfo) -> [TcPatSynInfo] -> [TcSigInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map TcPatSynInfo -> TcSigInfo
    TcPatSynSig [TcPatSynInfo]
    tpsigs) }

    tcTySig LSig GhcRn
    _ = [TcSigInfo] -> TcRn [TcSigInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    tcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name
                  -> TcM TcIdSigInfo
    -- A function or expression type signature
    -- Returns a fully quantified type signature; even the wildcards
    -- are quantified with ordinary skolems that should be instantiated
    --
    -- The SrcSpan is what to declare as the binding site of the
    -- any skolems in the signature. For function signatures we
    -- use the whole `f :: ty' signature; for expression signatures
    -- just the type part.
    --
    -- Just n  => Function type signature       name :: type
    -- Nothing => Expression type signature   <expr> :: type
    tcUserTypeSig :: SrcSpan
    -> LHsSigWcType GhcRn
    -> Maybe Name
    -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo
    tcUserTypeSig SrcSpan
    loc LHsSigWcType GhcRn
    hs_sig_ty Maybe Name
    mb_name
      | LHsSigWcType GhcRn -> Bool
    isCompleteHsSig LHsSigWcType GhcRn
    hs_sig_ty
      = do { Kind
    sigma_ty <- UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Kind
    tcHsSigWcType UserTypeCtxt
    ctxt_F LHsSigWcType GhcRn
    hs_sig_ty
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcuser" (Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    sigma_ty)
           ; TcIdSigInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcIdSigInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo)
    -> TcIdSigInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo
    forall a b. (a -> b) -> a -> b
    $
             CompleteSig { sig_bndr :: TcId
    sig_bndr  = HasDebugCallStack => Name -> Kind -> Kind -> TcId
    Name -> Kind -> Kind -> TcId
    mkLocalId Name
    name Kind
    Many Kind
    sigma_ty
                                       -- We use `Many' as the multiplicity here,
                                       -- as if this identifier corresponds to
                                       -- anything, it is a top-level
                                       -- definition. Which are all unrestricted in
                                       -- the current implementation.
                         , sig_ctxt :: UserTypeCtxt
    sig_ctxt  = UserTypeCtxt
    ctxt_T
                         , sig_loc :: SrcSpan
    sig_loc   = SrcSpan
    loc } }
                           -- Location of the <type> in   f :: <type>

      -- Partial sig with wildcards
      | Bool
    otherwise
      = TcIdSigInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcIdSigInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartialSig { psig_name :: Name
    psig_name = Name
    name, psig_hs_ty :: LHsSigWcType GhcRn
    psig_hs_ty = LHsSigWcType GhcRn
    hs_sig_ty
                           , sig_ctxt :: UserTypeCtxt
    sig_ctxt = UserTypeCtxt
    ctxt_F, sig_loc :: SrcSpan
    sig_loc = SrcSpan
    loc })
      where
        name :: Name
    name   = case Maybe Name
    mb_name of
                   Just Name
    n  -> Name
    n
                   Maybe Name
    Nothing -> OccName -> Name
    mkUnboundName (String -> OccName
    mkVarOcc String
    "<expression>")
        ctxt_F :: UserTypeCtxt
    ctxt_F = case Maybe Name
    mb_name of
                   Just Name
    n  -> Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    n Bool
    False
                   Maybe Name
    Nothing -> UserTypeCtxt
    ExprSigCtxt
        ctxt_T :: UserTypeCtxt
    ctxt_T = case Maybe Name
    mb_name of
                   Just Name
    n  -> Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    n Bool
    True
                   Maybe Name
    Nothing -> UserTypeCtxt
    ExprSigCtxt

    completeSigFromId :: UserTypeCtxt -> Id -> TcIdSigInfo
    -- Used for instance methods and record selectors
    completeSigFromId :: UserTypeCtxt -> TcId -> TcIdSigInfo
    completeSigFromId UserTypeCtxt
    ctxt TcId
    id
      = CompleteSig { sig_bndr :: TcId
    sig_bndr = TcId
    id
                    , sig_ctxt :: UserTypeCtxt
    sig_ctxt = UserTypeCtxt
    ctxt
                    , sig_loc :: SrcSpan
    sig_loc  = TcId -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan TcId
    id }

    isCompleteHsSig :: LHsSigWcType GhcRn -> Bool
    -- ^ If there are no wildcards, return a LHsSigWcType
    isCompleteHsSig :: LHsSigWcType GhcRn -> Bool
    isCompleteHsSig (HsWC { hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
    hswc_ext = XHsWC GhcRn (LHsSigType GhcRn)
    wcs, hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
    hswc_body = LHsSigType GhcRn
    hs_sig_ty })
       = [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    XHsWC GhcRn (LHsSigType GhcRn)
    wcs Bool -> Bool -> Bool
    && LHsSigType GhcRn -> Bool
    no_anon_wc_sig_ty LHsSigType GhcRn
    hs_sig_ty

    no_anon_wc_sig_ty :: LHsSigType GhcRn -> Bool
    no_anon_wc_sig_ty :: LHsSigType GhcRn -> Bool
    no_anon_wc_sig_ty (L SrcSpanAnnA
    _ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
    sig_bndrs = HsOuterSigTyVarBndrs GhcRn
    outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
    sig_body = LHsType GhcRn
    body}))
      =  (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn) -> Bool
    forall flag. LHsTyVarBndr flag GhcRn -> Bool
    no_anon_wc_tvb (HsOuterSigTyVarBndrs GhcRn
    -> [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
    forall flag (p :: Pass).
    HsOuterTyVarBndrs flag (GhcPass p)
    -> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
    hsOuterExplicitBndrs HsOuterSigTyVarBndrs GhcRn
    outer_bndrs)
      Bool -> Bool -> Bool
    && LHsType GhcRn -> Bool
    no_anon_wc_ty LHsType GhcRn
    body

    no_anon_wc_ty :: LHsType GhcRn -> Bool
    no_anon_wc_ty :: LHsType GhcRn -> Bool
    no_anon_wc_ty LHsType GhcRn
    lty = GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    lty
      where
        go :: GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go (L SrcSpanAnnA
    _ HsType GhcRn
    ty) = case HsType GhcRn
    ty of
          HsWildCardTy XWildCardTy GhcRn
    _                 -> Bool
    False
          HsAppTy XAppTy GhcRn
    _ LHsType GhcRn
    ty1 LHsType GhcRn
    ty2              -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty1 Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty2
          HsAppKindTy XAppKindTy GhcRn
    _ LHsType GhcRn
    ty LHsType GhcRn
    ki            -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ki
          HsFunTy XFunTy GhcRn
    _ HsArrow GhcRn
    w LHsType GhcRn
    ty1 LHsType GhcRn
    ty2            -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty1 Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty2 Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go (HsArrow GhcRn -> LHsType GhcRn
    arrowToHsType HsArrow GhcRn
    w)
          HsListTy XListTy GhcRn
    _ LHsType GhcRn
    ty                  -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsTupleTy XTupleTy GhcRn
    _ HsTupleSort
    _ [LHsType GhcRn]
    tys              -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos [GenLocated SrcSpanAnnA (HsType GhcRn)]
    [LHsType GhcRn]
    tys
          HsSumTy XSumTy GhcRn
    _ [LHsType GhcRn]
    tys                  -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos [GenLocated SrcSpanAnnA (HsType GhcRn)]
    [LHsType GhcRn]
    tys
          HsOpTy XOpTy GhcRn
    _ LHsType GhcRn
    ty1 LIdP GhcRn
    _ LHsType GhcRn
    ty2             -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty1 Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty2
          HsParTy XParTy GhcRn
    _ LHsType GhcRn
    ty                   -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsIParamTy XIParamTy GhcRn
    _ XRec GhcRn HsIPName
    _ LHsType GhcRn
    ty              -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsKindSig XKindSig GhcRn
    _ LHsType GhcRn
    ty LHsType GhcRn
    kind            -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    kind
          HsDocTy XDocTy GhcRn
    _ LHsType GhcRn
    ty LHsDocString
    _                 -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsBangTy XBangTy GhcRn
    _ HsSrcBang
    _ LHsType GhcRn
    ty                -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsRecTy XRecTy GhcRn
    _ [LConDeclField GhcRn]
    flds                 -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool)
    -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
     -> GenLocated SrcSpanAnnA (HsType GhcRn))
    -> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
    -> [GenLocated SrcSpanAnnA (HsType GhcRn)]
    forall a b. (a -> b) -> [a] -> [b]
    map (ConDeclField GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
    forall pass. ConDeclField pass -> LBangType pass
    cd_fld_type (ConDeclField GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
    -> (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
        -> ConDeclField GhcRn)
    -> GenLocated SrcSpanAnnA (ConDeclField GhcRn)
    -> GenLocated SrcSpanAnnA (HsType GhcRn)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> ConDeclField GhcRn
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
    [LConDeclField GhcRn]
    flds
          HsExplicitListTy XExplicitListTy GhcRn
    _ PromotionFlag
    _ [LHsType GhcRn]
    tys       -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos [GenLocated SrcSpanAnnA (HsType GhcRn)]
    [LHsType GhcRn]
    tys
          HsExplicitTupleTy XExplicitTupleTy GhcRn
    _ [LHsType GhcRn]
    tys        -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos [GenLocated SrcSpanAnnA (HsType GhcRn)]
    [LHsType GhcRn]
    tys
          HsForAllTy { hst_tele :: forall pass. HsType pass -> HsForAllTelescope pass
    hst_tele = HsForAllTelescope GhcRn
    tele
                     , hst_body :: forall pass. HsType pass -> LHsType pass
    hst_body = LHsType GhcRn
    ty } -> HsForAllTelescope GhcRn -> Bool
    no_anon_wc_tele HsForAllTelescope GhcRn
    tele
                                            Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsQualTy { hst_ctxt :: forall pass. HsType pass -> Maybe (LHsContext pass)
    hst_ctxt = Maybe (LHsContext GhcRn)
    ctxt
                   , hst_body :: forall pass. HsType pass -> LHsType pass
    hst_body = LHsType GhcRn
    ty }  -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos (Maybe (LHsContext GhcRn) -> [LHsType GhcRn]
    forall (p :: Pass).
    Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
    fromMaybeContext Maybe (LHsContext GhcRn)
    ctxt) Bool -> Bool -> Bool
    && GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go GenLocated SrcSpanAnnA (HsType GhcRn)
    LHsType GhcRn
    ty
          HsSpliceTy XSpliceTy GhcRn
    _ (HsSpliced XSpliced GhcRn
    _ ThModFinalizers
    _ (HsSplicedTy HsType GhcRn
    ty)) -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go (GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool)
    -> GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    forall a b. (a -> b) -> a -> b
    $ SrcSpanAnnA
    -> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    forall ann. SrcAnn ann
    noSrcSpanA HsType GhcRn
    ty
          HsSpliceTy{} -> Bool
    True
          HsTyLit{} -> Bool
    True
          HsTyVar{} -> Bool
    True
          HsStarTy{} -> Bool
    True
          XHsType{} -> Bool
    True       -- HsCoreTy, which does not have any wildcard

        gos :: [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    gos = (GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all GenLocated SrcSpanAnnA (HsType GhcRn) -> Bool
    go

    no_anon_wc_tele :: HsForAllTelescope GhcRn -> Bool
    no_anon_wc_tele :: HsForAllTelescope GhcRn -> Bool
    no_anon_wc_tele HsForAllTelescope GhcRn
    tele = case HsForAllTelescope GhcRn
    tele of
      HsForAllVis   { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
    hsf_vis_bndrs   = [LHsTyVarBndr () GhcRn]
    ltvs } -> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn) -> Bool
    forall flag. LHsTyVarBndr flag GhcRn -> Bool
    no_anon_wc_tvb [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
    [LHsTyVarBndr () GhcRn]
    ltvs
      HsForAllInvis { hsf_invis_bndrs :: forall pass.
    HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
    hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcRn]
    ltvs } -> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn) -> Bool
    forall flag. LHsTyVarBndr flag GhcRn -> Bool
    no_anon_wc_tvb [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcRn)]
    [LHsTyVarBndr Specificity GhcRn]
    ltvs

    no_anon_wc_tvb :: LHsTyVarBndr flag GhcRn -> Bool
    no_anon_wc_tvb :: forall flag. LHsTyVarBndr flag GhcRn -> Bool
    no_anon_wc_tvb (L SrcSpanAnnA
    _ HsTyVarBndr flag GhcRn
    tvb) = case HsTyVarBndr flag GhcRn
    tvb of
      UserTyVar XUserTyVar GhcRn
    _ flag
    _ LIdP GhcRn
    _      -> Bool
    True
      KindedTyVar XKindedTyVar GhcRn
    _ flag
    _ LIdP GhcRn
    _ LHsType GhcRn
    ki -> LHsType GhcRn -> Bool
    no_anon_wc_ty LHsType GhcRn
    ki

    {- Note [Fail eagerly on bad signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If a type signature is wrong, fail immediately:

     * the type sigs may bind type variables, so proceeding without them
       can lead to a cascade of errors

     * the type signature might be ambiguous, in which case checking
       the code against the signature will give a very similar error
       to the ambiguity error.

    ToDo: this means we fall over if any top-level type signature in the
    module is wrong, because we typecheck all the signatures together
    (see GHC.Tc.Gen.Bind.tcValBinds).  Moreover, because of top-level
    captureTopConstraints, only insoluble constraints will be reported.
    We typecheck all signatures at the same time because a signature
    like   f,g :: blah   might have f and g from different SCCs.

    So it's a bit awkward to get better error recovery, and no one
    has complained!
    -}

    {- *********************************************************************
    *                                                                      *
            Type checking a pattern synonym signature
    *                                                                      *
    ************************************************************************

    Note [Pattern synonym signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Pattern synonym signatures are surprisingly tricky (see #11224 for example).
    In general they look like this:

       pattern P :: forall univ_tvs. req_theta
                 => forall ex_tvs. prov_theta
                 => arg1 -> .. -> argn -> res_ty

    For parsing and renaming we treat the signature as an ordinary LHsSigType.

    Once we get to type checking, we decompose it into its parts, in tcPatSynSig.

    * Note that 'forall univ_tvs' and 'req_theta =>'
            and 'forall ex_tvs'   and 'prov_theta =>'
      are all optional.  We gather the pieces at the top of tcPatSynSig

    * Initially the implicitly-bound tyvars (added by the renamer) include both
      universal and existential vars.

    * After we kind-check the pieces and convert to Types, we do kind generalisation.

    Note [Report unsolved equalities in tcPatSynSig]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's important that we solve /all/ the equalities in a pattern
    synonym signature, because we are going to zonk the signature to
    a Type (not a TcType), in GHC.Tc.TyCl.PatSyn.tc_patsyn_finish, and that
    fails if there are un-filled-in coercion variables mentioned
    in the type (#15694).

    So we solve all the equalities we can, and report any unsolved ones,
    rather than leaving them in the ambient constraints to be solved
    later.  Pattern synonyms are top-level, so there's no problem with
    completely solving them.
    -}

    tcPatSynSig :: Name -> LHsSigType GhcRn -> TcM TcPatSynInfo
    -- See Note [Pattern synonym signatures]
    -- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType
    tcPatSynSig :: Name
    -> LHsSigType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) TcPatSynInfo
    tcPatSynSig Name
    name sig_ty :: LHsSigType GhcRn
    sig_ty@(L SrcSpanAnnA
    _ (HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
    sig_bndrs = HsOuterSigTyVarBndrs GhcRn
    hs_outer_bndrs, sig_body :: forall pass. HsSigType pass -> LHsType pass
    sig_body = LHsType GhcRn
    hs_ty}))
      | (Maybe (LHsContext GhcRn)
    hs_req, LHsType GhcRn
    hs_ty1) <- LHsType GhcRn -> (Maybe (LHsContext GhcRn), LHsType GhcRn)
    forall (pass :: Pass).
    LHsType (GhcPass pass)
    -> (Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass))
    splitLHsQualTy LHsType GhcRn
    hs_ty
      , ([LHsTyVarBndr Specificity GhcRn]
    ex_hs_tvbndrs, Maybe (LHsContext GhcRn)
    hs_prov, LHsType GhcRn
    hs_body_ty) <- LHsType GhcRn
    -> ([LHsTyVarBndr Specificity GhcRn], Maybe (LHsContext GhcRn),
        LHsType GhcRn)
    forall (p :: Pass).
    LHsType (GhcPass p)
    -> ([LHsTyVarBndr Specificity (GhcPass p)],
        Maybe (LHsContext (GhcPass p)), LHsType (GhcPass p))
    splitLHsSigmaTyInvis LHsType GhcRn
    hs_ty1
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPatSynSig 1" (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (HsSigType GhcRn)
    LHsSigType GhcRn
    sig_ty)

           ; let skol_info :: SkolemInfo
    skol_info = Name -> SkolemInfo
    DataConSkol Name
    name
           ; (TcLevel
    tclvl, WantedConstraints
    wanted, (HsOuterTyVarBndrs Specificity GhcTc
    outer_bndrs, ([VarBndr TcId Specificity]
    ex_bndrs, ([Kind]
    req, [Kind]
    prov, Kind
    body_ty))))
               <- String
    -> TcM
         (HsOuterTyVarBndrs Specificity GhcTc,
          ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
    -> TcM
         (TcLevel, WantedConstraints,
          (HsOuterTyVarBndrs Specificity GhcTc,
           ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))))
    forall a. String -> TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndSolveEqualitiesX String
    "tcPatSynSig"           (TcM
       (HsOuterTyVarBndrs Specificity GhcTc,
        ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
     -> TcM
          (TcLevel, WantedConstraints,
           (HsOuterTyVarBndrs Specificity GhcTc,
            ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))))
    -> TcM
         (HsOuterTyVarBndrs Specificity GhcTc,
          ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
    -> TcM
         (TcLevel, WantedConstraints,
          (HsOuterTyVarBndrs Specificity GhcTc,
           ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))))
    forall a b. (a -> b) -> a -> b
    $
                         -- See Note [solveEqualities in tcPatSynSig]
                  SkolemInfo
    -> HsOuterSigTyVarBndrs GhcRn
    -> TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))
    -> TcM
         (HsOuterTyVarBndrs Specificity GhcTc,
          ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
    forall flag a.
    OutputableBndrFlag flag 'Renamed =>
    SkolemInfo
    -> HsOuterTyVarBndrs flag GhcRn
    -> TcM a
    -> TcM (HsOuterTyVarBndrs flag GhcTc, a)
    tcOuterTKBndrs SkolemInfo
    skol_info HsOuterSigTyVarBndrs GhcRn
    hs_outer_bndrs (TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))
     -> TcM
          (HsOuterTyVarBndrs Specificity GhcTc,
           ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))))
    -> TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))
    -> TcM
         (HsOuterTyVarBndrs Specificity GhcTc,
          ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
    forall a b. (a -> b) -> a -> b
    $
                  [LHsTyVarBndr Specificity GhcRn]
    -> TcM ([Kind], [Kind], Kind)
    -> TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))
    forall flag a.
    OutputableBndrFlag flag 'Renamed =>
    [LHsTyVarBndr flag GhcRn] -> TcM a -> TcM ([VarBndr TcId flag], a)
    tcExplicitTKBndrs [LHsTyVarBndr Specificity GhcRn]
    ex_hs_tvbndrs         (TcM ([Kind], [Kind], Kind)
     -> TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind)))
    -> TcM ([Kind], [Kind], Kind)
    -> TcM ([VarBndr TcId Specificity], ([Kind], [Kind], Kind))
    forall a b. (a -> b) -> a -> b
    $
                  do { [Kind]
    req     <- Maybe (LHsContext GhcRn) -> TcM [Kind]
    tcHsContext Maybe (LHsContext GhcRn)
    hs_req
                     ; [Kind]
    prov    <- Maybe (LHsContext GhcRn) -> TcM [Kind]
    tcHsContext Maybe (LHsContext GhcRn)
    hs_prov
                     ; Kind
    body_ty <- LHsType GhcRn -> TcM Kind
    tcHsOpenType LHsType GhcRn
    hs_body_ty
                         -- A (literal) pattern can be unlifted;
                         -- e.g. pattern Zero <- 0#   (#12094)
                     ; ([Kind], [Kind], Kind) -> TcM ([Kind], [Kind], Kind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Kind]
    req, [Kind]
    prov, Kind
    body_ty) }

           ; let implicit_tvs :: [TcTyVar]
                 univ_bndrs   :: [TcInvisTVBinder]
                 ([TcId]
    implicit_tvs, [VarBndr TcId Specificity]
    univ_bndrs) = case HsOuterTyVarBndrs Specificity GhcTc
    outer_bndrs of
                   HsOuterImplicit{hso_ximplicit :: forall flag pass.
    HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
    hso_ximplicit = XHsOuterImplicit GhcTc
    implicit_tvs} -> ([TcId]
    XHsOuterImplicit GhcTc
    implicit_tvs, [])
                   HsOuterExplicit{hso_xexplicit :: forall flag pass.
    HsOuterTyVarBndrs flag pass -> XHsOuterExplicit pass flag
    hso_xexplicit = XHsOuterExplicit GhcTc Specificity
    univ_bndrs}   -> ([], [VarBndr TcId Specificity]
    XHsOuterExplicit GhcTc Specificity
    univ_bndrs)

           ; [TcId]
    implicit_tvs <- [TcId] -> TcM [TcId]
    zonkAndScopedSort [TcId]
    implicit_tvs
           ; let implicit_bndrs :: [VarBndr TcId Specificity]
    implicit_bndrs = Specificity -> [TcId] -> [VarBndr TcId Specificity]
    forall vis. vis -> [TcId] -> [VarBndr TcId vis]
    mkTyVarBinders Specificity
    SpecifiedSpec [TcId]
    implicit_tvs

           -- Kind generalisation
           ; let ungen_patsyn_ty :: Kind
    ungen_patsyn_ty = [VarBndr TcId Specificity]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> Kind
    -> Kind
    build_patsyn_type [VarBndr TcId Specificity]
    implicit_bndrs [VarBndr TcId Specificity]
    univ_bndrs
                                                     [Kind]
    req [VarBndr TcId Specificity]
    ex_bndrs [Kind]
    prov Kind
    body_ty
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcPatSynSig" (Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    ungen_patsyn_ty)
           ; [TcId]
    kvs <- Kind -> TcM [TcId]
    kindGeneralizeAll Kind
    ungen_patsyn_ty
           ; SkolemInfo -> [TcId] -> TcLevel -> WantedConstraints -> TcRn ()
    reportUnsolvedEqualities SkolemInfo
    skol_info [TcId]
    kvs TcLevel
    tclvl WantedConstraints
    wanted
                   -- See Note [Report unsolved equalities in tcPatSynSig]

           -- These are /signatures/ so we zonk to squeeze out any kind
           -- unification variables.  Do this after kindGeneralizeAll which may
           -- default kind variables to *.
           ; ZonkEnv
    ze                   <- ZonkFlexi -> TcM ZonkEnv
    mkEmptyZonkEnv ZonkFlexi
    NoFlexi
           ; (ZonkEnv
    ze, [VarBndr TcId Specificity]
    kv_bndrs)       <- ZonkEnv
    -> [VarBndr TcId Specificity]
    -> TcM (ZonkEnv, [VarBndr TcId Specificity])
    forall vis.
    ZonkEnv -> [VarBndr TcId vis] -> TcM (ZonkEnv, [VarBndr TcId vis])
    zonkTyVarBindersX   ZonkEnv
    ze (Specificity -> [TcId] -> [VarBndr TcId Specificity]
    forall vis. vis -> [TcId] -> [VarBndr TcId vis]
    mkTyVarBinders Specificity
    InferredSpec [TcId]
    kvs)
           ; (ZonkEnv
    ze, [VarBndr TcId Specificity]
    implicit_bndrs) <- ZonkEnv
    -> [VarBndr TcId Specificity]
    -> TcM (ZonkEnv, [VarBndr TcId Specificity])
    forall vis.
    ZonkEnv -> [VarBndr TcId vis] -> TcM (ZonkEnv, [VarBndr TcId vis])
    zonkTyVarBindersX   ZonkEnv
    ze [VarBndr TcId Specificity]
    implicit_bndrs
           ; (ZonkEnv
    ze, [VarBndr TcId Specificity]
    univ_bndrs)     <- ZonkEnv
    -> [VarBndr TcId Specificity]
    -> TcM (ZonkEnv, [VarBndr TcId Specificity])
    forall vis.
    ZonkEnv -> [VarBndr TcId vis] -> TcM (ZonkEnv, [VarBndr TcId vis])
    zonkTyVarBindersX   ZonkEnv
    ze [VarBndr TcId Specificity]
    univ_bndrs
           ; (ZonkEnv
    ze, [VarBndr TcId Specificity]
    ex_bndrs)       <- ZonkEnv
    -> [VarBndr TcId Specificity]
    -> TcM (ZonkEnv, [VarBndr TcId Specificity])
    forall vis.
    ZonkEnv -> [VarBndr TcId vis] -> TcM (ZonkEnv, [VarBndr TcId vis])
    zonkTyVarBindersX   ZonkEnv
    ze [VarBndr TcId Specificity]
    ex_bndrs
           ; [Kind]
    req                  <- ZonkEnv -> [Kind] -> TcM [Kind]
    zonkTcTypesToTypesX ZonkEnv
    ze [Kind]
    req
           ; [Kind]
    prov                 <- ZonkEnv -> [Kind] -> TcM [Kind]
    zonkTcTypesToTypesX ZonkEnv
    ze [Kind]
    prov
           ; Kind
    body_ty              <- ZonkEnv -> Kind -> TcM Kind
    zonkTcTypeToTypeX   ZonkEnv
    ze Kind
    body_ty

           -- Now do validity checking
           ; UserTypeCtxt -> Kind -> TcRn ()
    checkValidType UserTypeCtxt
    ctxt (Kind -> TcRn ()) -> Kind -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             [VarBndr TcId Specificity]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> Kind
    -> Kind
    build_patsyn_type [VarBndr TcId Specificity]
    implicit_bndrs [VarBndr TcId Specificity]
    univ_bndrs [Kind]
    req [VarBndr TcId Specificity]
    ex_bndrs [Kind]
    prov Kind
    body_ty

           -- arguments become the types of binders. We thus cannot allow
           -- levity polymorphism here
           ; let ([Scaled Kind]
    arg_tys, Kind
    _) = Kind -> ([Scaled Kind], Kind)
    tcSplitFunTys Kind
    body_ty
           ; (Scaled Kind -> TcRn ()) -> [Scaled Kind] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (SDoc -> Kind -> TcRn ()
    checkForLevPoly SDoc
    empty (Kind -> TcRn ())
    -> (Scaled Kind -> Kind) -> Scaled Kind -> TcRn ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Scaled Kind -> Kind
    forall a. Scaled a -> a
    scaledThing) [Scaled Kind]
    arg_tys

           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcTySig }" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "kvs"          SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    ppr_tvs ([VarBndr TcId Specificity] -> [TcId]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr TcId Specificity]
    kv_bndrs)
                  , String -> SDoc
    text String
    "implicit_tvs" SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    ppr_tvs ([VarBndr TcId Specificity] -> [TcId]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr TcId Specificity]
    implicit_bndrs)
                  , String -> SDoc
    text String
    "univ_tvs"     SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    ppr_tvs ([VarBndr TcId Specificity] -> [TcId]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr TcId Specificity]
    univ_bndrs)
                  , String -> SDoc
    text String
    "req" SDoc -> SDoc -> SDoc
    <+> [Kind] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Kind]
    req
                  , String -> SDoc
    text String
    "ex_tvs" SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    ppr_tvs ([VarBndr TcId Specificity] -> [TcId]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr TcId Specificity]
    ex_bndrs)
                  , String -> SDoc
    text String
    "prov" SDoc -> SDoc -> SDoc
    <+> [Kind] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Kind]
    prov
                  , String -> SDoc
    text String
    "body_ty" SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    body_ty ]
           ; TcPatSynInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcPatSynInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TPSI { patsig_name :: Name
    patsig_name = Name
    name
                          , patsig_implicit_bndrs :: [VarBndr TcId Specificity]
    patsig_implicit_bndrs = [VarBndr TcId Specificity]
    kv_bndrs [VarBndr TcId Specificity]
    -> [VarBndr TcId Specificity] -> [VarBndr TcId Specificity]
    forall a. [a] -> [a] -> [a]
    ++ [VarBndr TcId Specificity]
    implicit_bndrs
                          , patsig_univ_bndrs :: [VarBndr TcId Specificity]
    patsig_univ_bndrs     = [VarBndr TcId Specificity]
    univ_bndrs
                          , patsig_req :: [Kind]
    patsig_req            = [Kind]
    req
                          , patsig_ex_bndrs :: [VarBndr TcId Specificity]
    patsig_ex_bndrs       = [VarBndr TcId Specificity]
    ex_bndrs
                          , patsig_prov :: [Kind]
    patsig_prov           = [Kind]
    prov
                          , patsig_body_ty :: Kind
    patsig_body_ty        = Kind
    body_ty }) }
      where
        ctxt :: UserTypeCtxt
    ctxt = Name -> UserTypeCtxt
    PatSynCtxt Name
    name

        build_patsyn_type :: [VarBndr TcId Specificity]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> [VarBndr TcId Specificity]
    -> [Kind]
    -> Kind
    -> Kind
    build_patsyn_type [VarBndr TcId Specificity]
    implicit_bndrs [VarBndr TcId Specificity]
    univ_bndrs [Kind]
    req [VarBndr TcId Specificity]
    ex_bndrs [Kind]
    prov Kind
    body
          = [VarBndr TcId Specificity] -> Kind -> Kind
    mkInvisForAllTys [VarBndr TcId Specificity]
    implicit_bndrs (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
            [VarBndr TcId Specificity] -> Kind -> Kind
    mkInvisForAllTys [VarBndr TcId Specificity]
    univ_bndrs (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
            [Kind] -> Kind -> Kind
    mkPhiTy [Kind]
    req (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
            [VarBndr TcId Specificity] -> Kind -> Kind
    mkInvisForAllTys [VarBndr TcId Specificity]
    ex_bndrs (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
            [Kind] -> Kind -> Kind
    mkPhiTy [Kind]
    prov (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
            Kind
    body

    ppr_tvs :: [TyVar] -> SDoc
    ppr_tvs :: [TcId] -> SDoc
    ppr_tvs [TcId]
    tvs = SDoc -> SDoc
    braces ([SDoc] -> SDoc
    vcat [ TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> Kind
    tyVarKind TcId
    tv)
                               | TcId
    tv <- [TcId]
    tvs])

    {- *********************************************************************
    *                                                                      *
                   Instantiating user signatures
    *                                                                      *
    ********************************************************************* -}

    tcInstSig :: TcIdSigInfo -> TcM TcIdSigInst
    -- Instantiate a type signature; only used with plan InferGen
    tcInstSig :: TcIdSigInfo -> TcM TcIdSigInst
    tcInstSig sig :: TcIdSigInfo
    sig@(CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr = TcId
    poly_id, sig_loc :: TcIdSigInfo -> SrcSpan
    sig_loc = SrcSpan
    loc })
      = SrcSpan -> TcM TcIdSigInst -> TcM TcIdSigInst
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM TcIdSigInst -> TcM TcIdSigInst)
    -> TcM TcIdSigInst -> TcM TcIdSigInst
    forall a b. (a -> b) -> a -> b
    $  -- Set the binding site of the tyvars
        do { ([(Name, VarBndr TcId Specificity)]
    tv_prs, [Kind]
    theta, Kind
    tau) <- TcId -> TcM ([(Name, VarBndr TcId Specificity)], [Kind], Kind)
    tcInstTypeBndrs TcId
    poly_id
                  -- See Note [Pattern bindings and complete signatures]

           ; TcIdSigInst -> TcM TcIdSigInst
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TISI { sig_inst_sig :: TcIdSigInfo
    sig_inst_sig   = TcIdSigInfo
    sig
                          , sig_inst_skols :: [(Name, VarBndr TcId Specificity)]
    sig_inst_skols = [(Name, VarBndr TcId Specificity)]
    tv_prs
                          , sig_inst_wcs :: [(Name, TcId)]
    sig_inst_wcs   = []
                          , sig_inst_wcx :: Maybe Kind
    sig_inst_wcx   = Maybe Kind
    forall a. Maybe a
    Nothing
                          , sig_inst_theta :: [Kind]
    sig_inst_theta = [Kind]
    theta
                          , sig_inst_tau :: Kind
    sig_inst_tau   = Kind
    tau }) }

    tcInstSig hs_sig :: TcIdSigInfo
    hs_sig@(PartialSig { psig_hs_ty :: TcIdSigInfo -> LHsSigWcType GhcRn
    psig_hs_ty = LHsSigWcType GhcRn
    hs_ty
                                 , sig_ctxt :: TcIdSigInfo -> UserTypeCtxt
    sig_ctxt = UserTypeCtxt
    ctxt
                                 , sig_loc :: TcIdSigInfo -> SrcSpan
    sig_loc = SrcSpan
    loc })
      = SrcSpan -> TcM TcIdSigInst -> TcM TcIdSigInst
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM TcIdSigInst -> TcM TcIdSigInst)
    -> TcM TcIdSigInst -> TcM TcIdSigInst
    forall a b. (a -> b) -> a -> b
    $  -- Set the binding site of the tyvars
        do { String -> SDoc -> TcRn ()
    traceTc String
    "Staring partial sig {" (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    hs_sig)
           ; ([(Name, TcId)]
    wcs, Maybe Kind
    wcx, [(Name, VarBndr TcId Specificity)]
    tv_prs, [Kind]
    theta, Kind
    tau) <- UserTypeCtxt
    -> LHsSigWcType GhcRn
    -> TcM
         ([(Name, TcId)], Maybe Kind, [(Name, VarBndr TcId Specificity)],
          [Kind], Kind)
    tcHsPartialSigType UserTypeCtxt
    ctxt LHsSigWcType GhcRn
    hs_ty
             -- See Note [Checking partial type signatures] in GHC.Tc.Gen.HsType
           ; let inst_sig :: TcIdSigInst
    inst_sig = TISI { sig_inst_sig :: TcIdSigInfo
    sig_inst_sig   = TcIdSigInfo
    hs_sig
                                 , sig_inst_skols :: [(Name, VarBndr TcId Specificity)]
    sig_inst_skols = [(Name, VarBndr TcId Specificity)]
    tv_prs
                                 , sig_inst_wcs :: [(Name, TcId)]
    sig_inst_wcs   = [(Name, TcId)]
    wcs
                                 , sig_inst_wcx :: Maybe Kind
    sig_inst_wcx   = Maybe Kind
    wcx
                                 , sig_inst_theta :: [Kind]
    sig_inst_theta = [Kind]
    theta
                                 , sig_inst_tau :: Kind
    sig_inst_tau   = Kind
    tau }
           ; String -> SDoc -> TcRn ()
    traceTc String
    "End partial sig }" (TcIdSigInst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInst
    inst_sig)
           ; TcIdSigInst -> TcM TcIdSigInst
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcIdSigInst
    inst_sig }

    {- Note [Pattern bindings and complete signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
          data T a = MkT a a
          f :: forall a. a->a
          g :: forall b. b->b
          MkT f g = MkT (\x->x) (\y->y)
    Here we'll infer a type from the pattern of 'T a', but if we feed in
    the signature types for f and g, we'll end up unifying 'a' and 'b'

    So we instantiate f and g's signature with TyVarTv skolems
    (newMetaTyVarTyVars) that can unify with each other.  If too much
    unification takes place, we'll find out when we do the final
    impedance-matching check in GHC.Tc.Gen.Bind.mkExport

    See Note [TyVarTv] in GHC.Tc.Utils.TcMType

    None of this applies to a function binding with a complete
    signature, which doesn't use tcInstSig.  See GHC.Tc.Gen.Bind.tcPolyCheck.
    -}

    {- *********************************************************************
    *                                                                      *
                       Pragmas and PragEnv
    *                                                                      *
    ********************************************************************* -}

    type TcPragEnv = NameEnv [LSig GhcRn]

    emptyPragEnv :: TcPragEnv
    emptyPragEnv :: TcPragEnv
    emptyPragEnv = TcPragEnv
    forall a. NameEnv a
    emptyNameEnv

    lookupPragEnv :: TcPragEnv -> Name -> [LSig GhcRn]
    lookupPragEnv :: TcPragEnv -> Name -> [LSig GhcRn]
    lookupPragEnv TcPragEnv
    prag_fn Name
    n = NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> Name -> Maybe [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    TcPragEnv
    prag_fn Name
    n Maybe [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. Maybe a -> a -> a
    `orElse` []

    extendPragEnv :: TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv
    extendPragEnv :: TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv
    extendPragEnv TcPragEnv
    prag_fn (Name
    n, LSig GhcRn
    sig) = (GenLocated SrcSpanAnnA (Sig GhcRn)
     -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
     -> [GenLocated SrcSpanAnnA (Sig GhcRn)])
    -> (GenLocated SrcSpanAnnA (Sig GhcRn)
        -> [GenLocated SrcSpanAnnA (Sig GhcRn)])
    -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> Name
    -> GenLocated SrcSpanAnnA (Sig GhcRn)
    -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a b.
    (a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
    extendNameEnv_Acc (:) GenLocated SrcSpanAnnA (Sig GhcRn)
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. a -> [a]
    Utils.singleton NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    TcPragEnv
    prag_fn Name
    n GenLocated SrcSpanAnnA (Sig GhcRn)
    LSig GhcRn
    sig

    ---------------
    mkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv
    mkPragEnv :: [LSig GhcRn] -> LHsBinds GhcRn -> TcPragEnv
    mkPragEnv [LSig GhcRn]
    sigs LHsBinds GhcRn
    binds
      = (NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
     -> (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
     -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)])
    -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [(Name, GenLocated SrcSpanAnnA (Sig GhcRn))]
    -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    -> NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    TcPragEnv -> (Name, LSig GhcRn) -> TcPragEnv
    extendPragEnv NameEnv [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. NameEnv a
    emptyNameEnv [(Name, GenLocated SrcSpanAnnA (Sig GhcRn))]
    prs
      where
        prs :: [(Name, GenLocated SrcSpanAnnA (Sig GhcRn))]
    prs = (GenLocated SrcSpanAnnA (Sig GhcRn)
     -> Maybe (Name, GenLocated SrcSpanAnnA (Sig GhcRn)))
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [(Name, GenLocated SrcSpanAnnA (Sig GhcRn))]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe GenLocated SrcSpanAnnA (Sig GhcRn)
    -> Maybe (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    LSig GhcRn -> Maybe (Name, LSig GhcRn)
    get_sig [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    sigs

        get_sig :: LSig GhcRn -> Maybe (Name, LSig GhcRn)
        get_sig :: LSig GhcRn -> Maybe (Name, LSig GhcRn)
    get_sig (L SrcSpanAnnA
    l (SpecSig XSpecSig GhcRn
    x lnm :: LIdP GhcRn
    lnm@(L SrcSpanAnnN
    _ Name
    nm) [LHsSigType GhcRn]
    ty InlinePragma
    inl))
          = (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Maybe (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    forall a. a -> Maybe a
    Just (Name
    nm, SrcSpanAnnA -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XSpecSig GhcRn
    -> LIdP GhcRn -> [LHsSigType GhcRn] -> InlinePragma -> Sig GhcRn
    forall pass.
    XSpecSig pass
    -> LIdP pass -> [LHsSigType pass] -> InlinePragma -> Sig pass
    SpecSig   XSpecSig GhcRn
    x LIdP GhcRn
    lnm [LHsSigType GhcRn]
    ty (Name -> InlinePragma -> InlinePragma
    add_arity Name
    nm InlinePragma
    inl))
        get_sig (L SrcSpanAnnA
    l (InlineSig XInlineSig GhcRn
    x lnm :: LIdP GhcRn
    lnm@(L SrcSpanAnnN
    _ Name
    nm) InlinePragma
    inl))
          = (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Maybe (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    forall a. a -> Maybe a
    Just (Name
    nm, SrcSpanAnnA -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XInlineSig GhcRn -> LIdP GhcRn -> InlinePragma -> Sig GhcRn
    forall pass.
    XInlineSig pass -> LIdP pass -> InlinePragma -> Sig pass
    InlineSig XInlineSig GhcRn
    x LIdP GhcRn
    lnm    (Name -> InlinePragma -> InlinePragma
    add_arity Name
    nm InlinePragma
    inl))
        get_sig (L SrcSpanAnnA
    l (SCCFunSig XSCCFunSig GhcRn
    x SourceText
    st lnm :: LIdP GhcRn
    lnm@(L SrcSpanAnnN
    _ Name
    nm) Maybe (XRec GhcRn StringLiteral)
    str))
          = (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Maybe (Name, GenLocated SrcSpanAnnA (Sig GhcRn))
    forall a. a -> Maybe a
    Just (Name
    nm, SrcSpanAnnA -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XSCCFunSig GhcRn
    -> SourceText
    -> LIdP GhcRn
    -> Maybe (XRec GhcRn StringLiteral)
    -> Sig GhcRn
    forall pass.
    XSCCFunSig pass
    -> SourceText
    -> LIdP pass
    -> Maybe (XRec pass StringLiteral)
    -> Sig pass
    SCCFunSig XSCCFunSig GhcRn
    x SourceText
    st LIdP GhcRn
    lnm Maybe (XRec GhcRn StringLiteral)
    str)
        get_sig LSig GhcRn
    _ = Maybe (Name, LSig GhcRn)
    forall a. Maybe a
    Nothing

        add_arity :: Name -> InlinePragma -> InlinePragma
    add_arity Name
    n InlinePragma
    inl_prag   -- Adjust inl_sat field to match visible arity of function
          | InlineSpec
    Inline <- InlinePragma -> InlineSpec
    inl_inline InlinePragma
    inl_prag
            -- add arity only for real INLINE pragmas, not INLINABLE
          = case NameEnv Arity -> Name -> Maybe Arity
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv Arity
    ar_env Name
    n of
              Just Arity
    ar -> InlinePragma
    inl_prag { inl_sat :: Maybe Arity
    inl_sat = Arity -> Maybe Arity
    forall a. a -> Maybe a
    Just Arity
    ar }
              Maybe Arity
    Nothing -> WARN( True, text "mkPragEnv no arity" <+> ppr n )
                         -- There really should be a binding for every INLINE pragma
                         InlinePragma
    inl_prag
          | Bool
    otherwise
          = InlinePragma
    inl_prag

        -- ar_env maps a local to the arity of its definition
        ar_env :: NameEnv Arity
        ar_env :: NameEnv Arity
    ar_env = (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
     -> NameEnv Arity -> NameEnv Arity)
    -> NameEnv Arity
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
    -> NameEnv Arity
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
    -> NameEnv Arity -> NameEnv Arity
    LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity
    lhsBindArity NameEnv Arity
    forall a. NameEnv a
    emptyNameEnv Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
    LHsBinds GhcRn
    binds

    lhsBindArity :: LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity
    lhsBindArity :: LHsBind GhcRn -> NameEnv Arity -> NameEnv Arity
    lhsBindArity (L SrcSpanAnnA
    _ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = LIdP GhcRn
    id, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup GhcRn (LHsExpr GhcRn)
    ms })) NameEnv Arity
    env
      = NameEnv Arity -> Name -> Arity -> NameEnv Arity
    forall a. NameEnv a -> Name -> a -> NameEnv a
    extendNameEnv NameEnv Arity
    env (GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnN Name
    LIdP GhcRn
    id) (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> Arity
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> Arity
    matchGroupArity MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    MatchGroup GhcRn (LHsExpr GhcRn)
    ms)
    lhsBindArity LHsBind GhcRn
    _ NameEnv Arity
    env = NameEnv Arity
    env        -- PatBind/VarBind

    -----------------
    addInlinePrags :: TcId -> [LSig GhcRn] -> TcM TcId
    addInlinePrags :: TcId -> [LSig GhcRn] -> TcM TcId
    addInlinePrags TcId
    poly_id [LSig GhcRn]
    prags_for_me
      | inl :: GenLocated SrcSpanAnnA InlinePragma
    inl@(L SrcSpanAnnA
    _ InlinePragma
    prag) : [GenLocated SrcSpanAnnA InlinePragma]
    inls <- [GenLocated SrcSpanAnnA InlinePragma]
    inl_prags
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "addInlinePrag" (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id SDoc -> SDoc -> SDoc
    $$ InlinePragma -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InlinePragma
    prag)
           ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenLocated SrcSpanAnnA InlinePragma] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpanAnnA InlinePragma]
    inls) (GenLocated SrcSpanAnnA InlinePragma
    -> [GenLocated SrcSpanAnnA InlinePragma] -> TcRn ()
    warn_multiple_inlines GenLocated SrcSpanAnnA InlinePragma
    inl [GenLocated SrcSpanAnnA InlinePragma]
    inls)
           ; TcId -> TcM TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcId
    poly_id TcId -> InlinePragma -> TcId
    `setInlinePragma` InlinePragma
    prag) }
      | Bool
    otherwise
      = TcId -> TcM TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcId
    poly_id
      where
        inl_prags :: [GenLocated SrcSpanAnnA InlinePragma]
    inl_prags = [SrcSpanAnnA -> InlinePragma -> GenLocated SrcSpanAnnA InlinePragma
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc InlinePragma
    prag | L SrcSpanAnnA
    loc (InlineSig XInlineSig GhcRn
    _ LIdP GhcRn
    _ InlinePragma
    prag) <- [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    prags_for_me]

        warn_multiple_inlines :: GenLocated SrcSpanAnnA InlinePragma
    -> [GenLocated SrcSpanAnnA InlinePragma] -> TcRn ()
    warn_multiple_inlines GenLocated SrcSpanAnnA InlinePragma
    _ [] = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        warn_multiple_inlines inl1 :: GenLocated SrcSpanAnnA InlinePragma
    inl1@(L SrcSpanAnnA
    loc InlinePragma
    prag1) (inl2 :: GenLocated SrcSpanAnnA InlinePragma
    inl2@(L SrcSpanAnnA
    _ InlinePragma
    prag2) : [GenLocated SrcSpanAnnA InlinePragma]
    inls)
           | InlinePragma -> Activation
    inlinePragmaActivation InlinePragma
    prag1 Activation -> Activation -> Bool
    forall a. Eq a => a -> a -> Bool
    == InlinePragma -> Activation
    inlinePragmaActivation InlinePragma
    prag2
           , InlineSpec -> Bool
    noUserInlineSpec (InlinePragma -> InlineSpec
    inlinePragmaSpec InlinePragma
    prag1)
           =    -- Tiresome: inl1 is put there by virtue of being in a hs-boot loop
                -- and inl2 is a user NOINLINE pragma; we don't want to complain
             GenLocated SrcSpanAnnA InlinePragma
    -> [GenLocated SrcSpanAnnA InlinePragma] -> TcRn ()
    warn_multiple_inlines GenLocated SrcSpanAnnA InlinePragma
    inl2 [GenLocated SrcSpanAnnA InlinePragma]
    inls
           | Bool
    otherwise
           = SrcSpanAnnA -> TcRn () -> TcRn ()
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             WarnReason -> SDoc -> TcRn ()
    addWarnTc WarnReason
    NoReason
                         (SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Multiple INLINE pragmas for" SDoc -> SDoc -> SDoc
    <+> TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id)
                           Arity
    2 ([SDoc] -> SDoc
    vcat (String -> SDoc
    text String
    "Ignoring all but the first"
                                    SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (GenLocated SrcSpanAnnA InlinePragma -> SDoc)
    -> [GenLocated SrcSpanAnnA InlinePragma] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA InlinePragma -> SDoc
    forall {a} {a}.
    (Outputable a, Outputable a) =>
    GenLocated a a -> SDoc
    pp_inl (GenLocated SrcSpanAnnA InlinePragma
    inl1GenLocated SrcSpanAnnA InlinePragma
    -> [GenLocated SrcSpanAnnA InlinePragma]
    -> [GenLocated SrcSpanAnnA InlinePragma]
    forall a. a -> [a] -> [a]
    :GenLocated SrcSpanAnnA InlinePragma
    inl2GenLocated SrcSpanAnnA InlinePragma
    -> [GenLocated SrcSpanAnnA InlinePragma]
    -> [GenLocated SrcSpanAnnA InlinePragma]
    forall a. a -> [a] -> [a]
    :[GenLocated SrcSpanAnnA InlinePragma]
    inls))))

        pp_inl :: GenLocated a a -> SDoc
    pp_inl (L a
    loc a
    prag) = a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    prag SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    loc)

    {- *********************************************************************
    *                                                                      *
                       SPECIALISE pragmas
    *                                                                      *
    ************************************************************************

    Note [Handling SPECIALISE pragmas]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The basic idea is this:

       foo :: Num a => a -> b -> a
       {-# SPECIALISE foo :: Int -> b -> Int #-}

    We check that
       (forall a b. Num a => a -> b -> a)
          is more polymorphic than
       forall b. Int -> b -> Int
    (for which we could use tcSubType, but see below), generating a HsWrapper
    to connect the two, something like
          wrap = /\b. <hole> Int b dNumInt
    This wrapper is put in the TcSpecPrag, in the ABExport record of
    the AbsBinds.

            f :: (Eq a, Ix b) => a -> b -> Bool
            {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}
            f = <poly_rhs>

    From this the typechecker generates

        AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds

        SpecPrag (wrap_fn :: forall a b. (Eq a, Ix b) => XXX
                          -> forall p q. (Ix p, Ix q) => XXX[ Int/a, (p,q)/b ])

    From these we generate:

        Rule:       forall p, q, (dp:Ix p), (dq:Ix q).
                        f Int (p,q) dInt ($dfInPair dp dq) = f_spec p q dp dq

        Spec bind:  f_spec = wrap_fn <poly_rhs>

    Note that

      * The LHS of the rule may mention dictionary *expressions* (eg
        $dfIxPair dp dq), and that is essential because the dp, dq are
        needed on the RHS.

      * The RHS of f_spec, <poly_rhs> has a *copy* of 'binds', so that it
        can fully specialise it.

    From the TcSpecPrag, in GHC.HsToCore.Binds we generate a binding for f_spec and a RULE:

       f_spec :: Int -> b -> Int
       f_spec = wrap<f rhs>

       RULE: forall b (d:Num b). f b d = f_spec b

    The RULE is generated by taking apart the HsWrapper, which is a little
    delicate, but works.

    Some wrinkles

    1. In tcSpecWrapper, rather than calling tcSubType, we directly call
       skolemise/instantiate.  That is mainly because of wrinkle (2).

       Historical note: in the past, tcSubType did co/contra stuff, which
       could generate too complex a LHS for the RULE, which was another
       reason for not using tcSubType.  But that reason has gone away
       with simple subsumption (#17775).

    2. We need to take care with type families (#5821).  Consider
          type instance F Int = Bool
          f :: Num a => a -> F a
          {-# SPECIALISE foo :: Int -> Bool #-}

      We *could* try to generate an f_spec with precisely the declared type:
          f_spec :: Int -> Bool
          f_spec = <f rhs> Int dNumInt |> co

          RULE: forall d. f Int d = f_spec |> sym co

      but the 'co' and 'sym co' are (a) playing no useful role, and (b) are
      hard to generate.  At all costs we must avoid this:
          RULE: forall d. f Int d |> co = f_spec
      because the LHS will never match (indeed it's rejected in
      decomposeRuleLhs).

      So we simply do this:
        - Generate a constraint to check that the specialised type (after
          skolemisation) is equal to the instantiated function type.
        - But *discard* the evidence (coercion) for that constraint,
          so that we ultimately generate the simpler code
              f_spec :: Int -> F Int
              f_spec = <f rhs> Int dNumInt

              RULE: forall d. f Int d = f_spec
          You can see this discarding happening in tcSpecPrag

    3. Note that the HsWrapper can transform *any* function with the right
       type prefix
           forall ab. (Eq a, Ix b) => XXX
       regardless of XXX.  It's sort of polymorphic in XXX.  This is
       useful: we use the same wrapper to transform each of the class ops, as
       well as the dict.  That's what goes on in GHC.Tc.TyCl.Instance.mk_meth_spec_prags
    -}

    tcSpecPrags :: Id -> [LSig GhcRn]
                -> TcM [LTcSpecPrag]
    -- Add INLINE and SPECIALSE pragmas
    --    INLINE prags are added to the (polymorphic) Id directly
    --    SPECIALISE prags are passed to the desugarer via TcSpecPrags
    -- Pre-condition: the poly_id is zonked
    -- Reason: required by tcSubExp
    tcSpecPrags :: TcId -> [LSig GhcRn] -> TcM [LTcSpecPrag]
    tcSpecPrags TcId
    poly_id [LSig GhcRn]
    prag_sigs
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcSpecPrags" (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id SDoc -> SDoc -> SDoc
    <+> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GenLocated SrcSpanAnnA (Sig GhcRn)]
    spec_sigs)
           ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenLocated SrcSpanAnnA (Sig GhcRn)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpanAnnA (Sig GhcRn)]
    bad_sigs) TcRn ()
    warn_discarded_sigs
           ; [GenLocated SrcSpanAnnA [TcSpecPrag]]
    pss <- (GenLocated SrcSpanAnnA (Sig GhcRn)
     -> TcRn (GenLocated SrcSpanAnnA [TcSpecPrag]))
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> TcRn [GenLocated SrcSpanAnnA [TcSpecPrag]]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM ((Sig GhcRn -> TcM [TcSpecPrag])
    -> GenLocated SrcSpanAnnA (Sig GhcRn)
    -> TcRn (GenLocated SrcSpanAnnA [TcSpecPrag])
    forall a b ann.
    (a -> TcM b)
    -> GenLocated (SrcSpanAnn' ann) a
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    wrapLocMA (TcId -> Sig GhcRn -> TcM [TcSpecPrag]
    tcSpecPrag TcId
    poly_id)) [GenLocated SrcSpanAnnA (Sig GhcRn)]
    spec_sigs
           ; [LTcSpecPrag] -> TcM [LTcSpecPrag]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LTcSpecPrag] -> TcM [LTcSpecPrag])
    -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA [TcSpecPrag] -> [LTcSpecPrag])
    -> [GenLocated SrcSpanAnnA [TcSpecPrag]] -> [LTcSpecPrag]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(L SrcSpanAnnA
    l [TcSpecPrag]
    ps) -> (TcSpecPrag -> LTcSpecPrag) -> [TcSpecPrag] -> [LTcSpecPrag]
    forall a b. (a -> b) -> [a] -> [b]
    map (SrcSpan -> TcSpecPrag -> LTcSpecPrag
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l)) [TcSpecPrag]
    ps) [GenLocated SrcSpanAnnA [TcSpecPrag]]
    pss }
      where
        spec_sigs :: [GenLocated SrcSpanAnnA (Sig GhcRn)]
    spec_sigs = (GenLocated SrcSpanAnnA (Sig GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenLocated SrcSpanAnnA (Sig GhcRn) -> Bool
    forall p. UnXRec p => LSig p -> Bool
    isSpecLSig [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    prag_sigs
        bad_sigs :: [GenLocated SrcSpanAnnA (Sig GhcRn)]
    bad_sigs  = (GenLocated SrcSpanAnnA (Sig GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GenLocated SrcSpanAnnA (Sig GhcRn) -> Bool
    forall p. UnXRec p => LSig p -> Bool
    is_bad_sig [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    prag_sigs
        is_bad_sig :: XRec p (Sig p) -> Bool
    is_bad_sig XRec p (Sig p)
    s = Bool -> Bool
    not (XRec p (Sig p) -> Bool
    forall p. UnXRec p => LSig p -> Bool
    isSpecLSig XRec p (Sig p)
    s Bool -> Bool -> Bool
    || XRec p (Sig p) -> Bool
    forall p. UnXRec p => LSig p -> Bool
    isInlineLSig XRec p (Sig p)
    s Bool -> Bool -> Bool
    || XRec p (Sig p) -> Bool
    forall p. UnXRec p => LSig p -> Bool
    isSCCFunSig XRec p (Sig p)
    s)

        warn_discarded_sigs :: TcRn ()
    warn_discarded_sigs
          = WarnReason -> SDoc -> TcRn ()
    addWarnTc WarnReason
    NoReason
                      (SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Discarding unexpected pragmas for" SDoc -> SDoc -> SDoc
    <+> TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id)
                          Arity
    2 ([SDoc] -> SDoc
    vcat ((GenLocated SrcSpanAnnA (Sig GhcRn) -> SDoc)
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SrcSpanAnnA -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (SrcSpanAnnA -> SDoc)
    -> (GenLocated SrcSpanAnnA (Sig GhcRn) -> SrcSpanAnnA)
    -> GenLocated SrcSpanAnnA (Sig GhcRn)
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (Sig GhcRn) -> SrcSpanAnnA
    forall l e. GenLocated l e -> l
    getLoc) [GenLocated SrcSpanAnnA (Sig GhcRn)]
    bad_sigs)))

    --------------
    tcSpecPrag :: TcId -> Sig GhcRn -> TcM [TcSpecPrag]
    tcSpecPrag :: TcId -> Sig GhcRn -> TcM [TcSpecPrag]
    tcSpecPrag TcId
    poly_id prag :: Sig GhcRn
    prag@(SpecSig XSpecSig GhcRn
    _ LIdP GhcRn
    fun_name [LHsSigType GhcRn]
    hs_tys InlinePragma
    inl)
    -- See Note [Handling SPECIALISE pragmas]
    --
    -- The Name fun_name in the SpecSig may not be the same as that of the poly_id
    -- Example: SPECIALISE for a class method: the Name in the SpecSig is
    --          for the selector Id, but the poly_id is something like $cop
    -- However we want to use fun_name in the error message, since that is
    -- what the user wrote (#8537)
      = SDoc -> TcM [TcSpecPrag] -> TcM [TcSpecPrag]
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Sig GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    spec_ctxt Sig GhcRn
    prag) (TcM [TcSpecPrag] -> TcM [TcSpecPrag])
    -> TcM [TcSpecPrag] -> TcM [TcSpecPrag]
    forall a b. (a -> b) -> a -> b
    $
        do  { Bool -> SDoc -> TcRn ()
    warnIf (Bool -> Bool
    not (Kind -> Bool
    isOverloadedTy Kind
    poly_ty Bool -> Bool -> Bool
    || InlinePragma -> Bool
    isInlinePragma InlinePragma
    inl))
                     (String -> SDoc
    text String
    "SPECIALISE pragma for non-overloaded function"
                      SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (GenLocated SrcSpanAnnN Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnN Name
    LIdP GhcRn
    fun_name))
                      -- Note [SPECIALISE pragmas]
            ; [TcSpecPrag]
    spec_prags <- (GenLocated SrcSpanAnnA (HsSigType GhcRn)
     -> IOEnv (Env TcGblEnv TcLclEnv) TcSpecPrag)
    -> [GenLocated SrcSpanAnnA (HsSigType GhcRn)] -> TcM [TcSpecPrag]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated SrcSpanAnnA (HsSigType GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) TcSpecPrag
    tc_one [GenLocated SrcSpanAnnA (HsSigType GhcRn)]
    [LHsSigType GhcRn]
    hs_tys
            ; String -> SDoc -> TcRn ()
    traceTc String
    "tcSpecPrag" (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id SDoc -> SDoc -> SDoc
    $$ Arity -> SDoc -> SDoc
    nest Arity
    2 ([SDoc] -> SDoc
    vcat ((TcSpecPrag -> SDoc) -> [TcSpecPrag] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map TcSpecPrag -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcSpecPrag]
    spec_prags)))
            ; [TcSpecPrag] -> TcM [TcSpecPrag]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [TcSpecPrag]
    spec_prags }
      where
        name :: Name
    name      = TcId -> Name
    idName TcId
    poly_id
        poly_ty :: Kind
    poly_ty   = TcId -> Kind
    idType TcId
    poly_id
        spec_ctxt :: a -> SDoc
    spec_ctxt a
    prag = SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the pragma:") Arity
    2 (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    prag)

        tc_one :: GenLocated SrcSpanAnnA (HsSigType GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) TcSpecPrag
    tc_one GenLocated SrcSpanAnnA (HsSigType GhcRn)
    hs_ty
          = do { Kind
    spec_ty <- UserTypeCtxt -> LHsSigType GhcRn -> TcM Kind
    tcHsSigType   (Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    name Bool
    False) GenLocated SrcSpanAnnA (HsSigType GhcRn)
    LHsSigType GhcRn
    hs_ty
               ; HsWrapper
    wrap    <- UserTypeCtxt -> Kind -> Kind -> TcM HsWrapper
    tcSpecWrapper (Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    name Bool
    True)  Kind
    poly_ty Kind
    spec_ty
               ; TcSpecPrag -> IOEnv (Env TcGblEnv TcLclEnv) TcSpecPrag
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcId -> HsWrapper -> InlinePragma -> TcSpecPrag
    SpecPrag TcId
    poly_id HsWrapper
    wrap InlinePragma
    inl) }

    tcSpecPrag TcId
    _ Sig GhcRn
    prag = String -> SDoc -> TcM [TcSpecPrag]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcSpecPrag" (Sig GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Sig GhcRn
    prag)

    --------------
    tcSpecWrapper :: UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper
    -- A simpler variant of tcSubType, used for SPECIALISE pragmas
    -- See Note [Handling SPECIALISE pragmas], wrinkle 1
    tcSpecWrapper :: UserTypeCtxt -> Kind -> Kind -> TcM HsWrapper
    tcSpecWrapper UserTypeCtxt
    ctxt Kind
    poly_ty Kind
    spec_ty
      = do { (HsWrapper
    sk_wrap, HsWrapper
    inst_wrap)
                   <- UserTypeCtxt
    -> Kind -> (Kind -> TcM HsWrapper) -> TcM (HsWrapper, HsWrapper)
    forall result.
    UserTypeCtxt
    -> Kind -> (Kind -> TcM result) -> TcM (HsWrapper, result)
    tcSkolemise UserTypeCtxt
    ctxt Kind
    spec_ty ((Kind -> TcM HsWrapper) -> TcM (HsWrapper, HsWrapper))
    -> (Kind -> TcM HsWrapper) -> TcM (HsWrapper, HsWrapper)
    forall a b. (a -> b) -> a -> b
    $ \ Kind
    spec_tau ->
                      do { (HsWrapper
    inst_wrap, Kind
    tau) <- CtOrigin -> Kind -> TcM (HsWrapper, Kind)
    topInstantiate CtOrigin
    orig Kind
    poly_ty
                         ; TcCoercionN
    _ <- Maybe SDoc -> Kind -> Kind -> TcM TcCoercionN
    unifyType Maybe SDoc
    forall a. Maybe a
    Nothing Kind
    spec_tau Kind
    tau
                                -- Deliberately ignore the evidence
                                -- See Note [Handling SPECIALISE pragmas],
                                --   wrinkle (2)
                         ; HsWrapper -> TcM HsWrapper
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsWrapper
    inst_wrap }
           ; HsWrapper -> TcM HsWrapper
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper
    sk_wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    inst_wrap) }
      where
        orig :: CtOrigin
    orig = UserTypeCtxt -> CtOrigin
    SpecPragOrigin UserTypeCtxt
    ctxt

    --------------
    tcImpPrags :: [LSig GhcRn] -> TcM [LTcSpecPrag]
    -- SPECIALISE pragmas for imported things
    tcImpPrags :: [LSig GhcRn] -> TcM [LTcSpecPrag]
    tcImpPrags [LSig GhcRn]
    prags
      = do { Module
    this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; if (DynFlags -> Bool
    not_specialising DynFlags
    dflags) then
                [LTcSpecPrag] -> TcM [LTcSpecPrag]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
             else do
                { [GenLocated SrcSpanAnnA [TcSpecPrag]]
    pss <- (GenLocated SrcSpanAnnA (Name, Sig GhcRn)
     -> TcRn (GenLocated SrcSpanAnnA [TcSpecPrag]))
    -> [GenLocated SrcSpanAnnA (Name, Sig GhcRn)]
    -> TcRn [GenLocated SrcSpanAnnA [TcSpecPrag]]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM (((Name, Sig GhcRn) -> TcM [TcSpecPrag])
    -> GenLocated SrcSpanAnnA (Name, Sig GhcRn)
    -> TcRn (GenLocated SrcSpanAnnA [TcSpecPrag])
    forall a b ann.
    (a -> TcM b)
    -> GenLocated (SrcSpanAnn' ann) a
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    wrapLocMA (Name, Sig GhcRn) -> TcM [TcSpecPrag]
    tcImpSpec)
                         [SrcSpanAnnA
    -> (Name, Sig GhcRn) -> GenLocated SrcSpanAnnA (Name, Sig GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc (Name
    name,Sig GhcRn
    prag)
                                 | (L SrcSpanAnnA
    loc prag :: Sig GhcRn
    prag@(SpecSig XSpecSig GhcRn
    _ (L SrcSpanAnnN
    _ Name
    name) [LHsSigType GhcRn]
    _ InlinePragma
    _)) <- [GenLocated SrcSpanAnnA (Sig GhcRn)]
    [LSig GhcRn]
    prags
                                 , Bool -> Bool
    not (Module -> Name -> Bool
    nameIsLocalOrFrom Module
    this_mod Name
    name) ]
                ; [LTcSpecPrag] -> TcM [LTcSpecPrag]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LTcSpecPrag] -> TcM [LTcSpecPrag])
    -> [LTcSpecPrag] -> TcM [LTcSpecPrag]
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA [TcSpecPrag] -> [LTcSpecPrag])
    -> [GenLocated SrcSpanAnnA [TcSpecPrag]] -> [LTcSpecPrag]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\(L SrcSpanAnnA
    l [TcSpecPrag]
    ps) -> (TcSpecPrag -> LTcSpecPrag) -> [TcSpecPrag] -> [LTcSpecPrag]
    forall a b. (a -> b) -> [a] -> [b]
    map (SrcSpan -> TcSpecPrag -> LTcSpecPrag
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l)) [TcSpecPrag]
    ps) [GenLocated SrcSpanAnnA [TcSpecPrag]]
    pss } }
      where
        -- Ignore SPECIALISE pragmas for imported things
        -- when we aren't specialising, or when we aren't generating
        -- code.  The latter happens when Haddocking the base library;
        -- we don't want complaints about lack of INLINABLE pragmas
        not_specialising :: DynFlags -> Bool
    not_specialising DynFlags
    dflags
          | Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Specialise DynFlags
    dflags) = Bool
    True
          | Bool
    otherwise = case DynFlags -> Backend
    backend DynFlags
    dflags of
                          Backend
    NoBackend   -> Bool
    True
                          Backend
    Interpreter -> Bool
    True
                          Backend
    _other      -> Bool
    False

    tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
    tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
    tcImpSpec (Name
    name, Sig GhcRn
    prag)
     = do { TcId
    id <- Name -> TcM TcId
    tcLookupId Name
    name
          ; if Unfolding -> Bool
    hasSomeUnfolding (TcId -> Unfolding
    realIdUnfolding TcId
    id)
               -- See Note [SPECIALISE pragmas for imported Ids]
            then TcId -> Sig GhcRn -> TcM [TcSpecPrag]
    tcSpecPrag TcId
    id Sig GhcRn
    prag
            else do { WarnReason -> SDoc -> TcRn ()
    addWarnTc WarnReason
    NoReason (Name -> SDoc
    impSpecErr Name
    name)
                    ; [TcSpecPrag] -> TcM [TcSpecPrag]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [] } }

    impSpecErr :: Name -> SDoc
    impSpecErr :: Name -> SDoc
    impSpecErr Name
    name
      = SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "You cannot SPECIALISE" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name))
           Arity
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "because its definition is not visible in this module"
                   , String -> SDoc
    text String
    "Hint: make sure" SDoc -> SDoc -> SDoc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is compiled with -O"
                   , String -> SDoc
    text String
    "      and that" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)
                     SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has an INLINABLE pragma" ])
      where
        mod :: Module
    mod = HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    name

    {- Note [SPECIALISE pragmas for imported Ids]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    An imported Id may or may not have an unfolding.  If not, we obviously
    can't specialise it here; indeed the desugar falls over (#18118).

    We used to test whether it had a user-specified INLINABLE pragma but,
    because of Note [Worker-wrapper for INLINABLE functions] in
    GHC.Core.Opt.WorkWrap, even an INLINABLE function may end up with
    a wrapper that has no pragma, just an unfolding (#19246).  So now
    we just test whether the function has an unfolding.

    There's a risk that a pragma-free function may have an unfolding now
    (because it is fairly small), and then gets a bit bigger, and no
    longer has an unfolding in the future.  But then you'll get a helpful
    error message suggesting an INLINABLE pragma, which you can follow.
    That seems enough for now.
    -}