    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE ViewPatterns #-}

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

    -- | Typechecking pattern synonym declarations
    module GHC.Tc.TyCl.PatSyn
       ( tcPatSynDecl
       , tcPatSynBuilderBind
       , tcPatSynBuilderOcc
       , nonBidirectionalErr
       )
    where

    import GHC.Prelude

    import GHC.Hs
    import GHC.Tc.Gen.Pat
    import GHC.Core.Multiplicity
    import GHC.Core.Type ( tidyTyCoVarBinders, tidyTypes, tidyType )
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Gen.Sig( emptyPragEnv, completeSigFromId )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.Zonk
    import GHC.Builtin.Types.Prim
    import GHC.Types.Name
    import GHC.Types.SrcLoc
    import GHC.Core.PatSyn
    import GHC.Types.Name.Set
    import GHC.Utils.Panic
    import GHC.Utils.Outputable
    import GHC.Data.FastString
    import GHC.Types.Var
    import GHC.Types.Var.Env( emptyTidyEnv, mkInScopeSet )
    import GHC.Types.Id
    import GHC.Types.Id.Info( RecSelParent(..), setLevityInfoWithType )
    import GHC.Tc.Gen.Bind
    import GHC.Types.Basic
    import GHC.Tc.Solver
    import GHC.Tc.Utils.Unify
    import GHC.Core.Predicate
    import GHC.Builtin.Types
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.Origin
    import GHC.Tc.TyCl.Build
    import GHC.Types.Var.Set
    import GHC.Types.Id.Make
    import GHC.Tc.TyCl.Utils
    import GHC.Core.ConLike
    import GHC.Types.FieldLabel
    import GHC.Data.Bag
    import GHC.Utils.Misc
    import GHC.Utils.Error
    import GHC.Driver.Session ( getDynFlags )
    import Data.Maybe( mapMaybe )
    import Control.Monad ( zipWithM )
    import Data.List( partition )

    #include "HsVersions.h"

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

    tcPatSynDecl :: PatSynBind GhcRn GhcRn
                 -> Maybe TcSigInfo
                 -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcPatSynDecl :: PatSynBind GhcRn GhcRn
    -> Maybe TcSigInfo -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcPatSynDecl PatSynBind GhcRn GhcRn
    psb Maybe TcSigInfo
    mb_sig
      = TcM (LHsBinds GhcTc, TcGblEnv)
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall r. TcRn r -> TcRn r -> TcRn r
    recoverM (PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc, TcGblEnv)
    recoverPSB PatSynBind GhcRn GhcRn
    psb) (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        case Maybe TcSigInfo
    mb_sig of
          Maybe TcSigInfo
    Nothing                 -> PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl PatSynBind GhcRn GhcRn
    psb
          Just (TcPatSynSig TcPatSynInfo
    tpsi) -> PatSynBind GhcRn GhcRn
    -> TcPatSynInfo -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl PatSynBind GhcRn GhcRn
    psb TcPatSynInfo
    tpsi
          Maybe TcSigInfo
    _                       -> String -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a. String -> a
    panic String
    "tcPatSynDecl"

    recoverPSB :: PatSynBind GhcRn GhcRn
               -> TcM (LHsBinds GhcTc, TcGblEnv)
    -- See Note [Pattern synonym error recovery]
    recoverPSB :: PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc, TcGblEnv)
    recoverPSB (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
    psb_id = L SrcSpan
    _ IdP GhcRn
    name
                    , psb_args :: forall idL idR.
    PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
    psb_args = HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details })
     = do { Name
    matcher_name <- Name -> (OccName -> OccName) -> TcRnIf TcGblEnv TcLclEnv Name
    forall m n. Name -> (OccName -> OccName) -> TcRnIf m n Name
    newImplicitBinder Name
    IdP GhcRn
    name OccName -> OccName
    mkMatcherOcc
          ; let placeholder :: TyThing
    placeholder = ConLike -> TyThing
    AConLike (ConLike -> TyThing) -> ConLike -> TyThing
    forall a b. (a -> b) -> a -> b
    $ PatSyn -> ConLike
    PatSynCon (PatSyn -> ConLike) -> PatSyn -> ConLike
    forall a b. (a -> b) -> a -> b
    $
                              Name -> PatSyn
    mk_placeholder Name
    matcher_name
          ; TcGblEnv
    gbl_env <- [TyThing] -> TcM TcGblEnv -> TcM TcGblEnv
    forall r. [TyThing] -> TcM r -> TcM r
    tcExtendGlobalEnv [TyThing
    placeholder] TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcTc
    forall a. Bag a
    emptyBag, TcGblEnv
    gbl_env) }
      where
        ([Name]
    _arg_names, [Name]
    _rec_fields, Bool
    is_infix) = HsPatSynDetails (Located Name) -> ([Name], [Name], Bool)
    collectPatSynArgInfo HsPatSynDetails (Located Name)
    HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details
        mk_placeholder :: Name -> PatSyn
    mk_placeholder Name
    matcher_name
          = Name
    -> Bool
    -> ([VarBndr Id Specificity], [Kind])
    -> ([VarBndr Id Specificity], [Kind])
    -> [Kind]
    -> Kind
    -> (Id, Bool)
    -> Maybe (Id, Bool)
    -> [FieldLabel]
    -> PatSyn
    mkPatSyn Name
    IdP GhcRn
    name Bool
    is_infix
                            ([Specificity -> Id -> VarBndr Id Specificity
    forall vis. vis -> Id -> VarBndr Id vis
    mkTyVarBinder Specificity
    SpecifiedSpec Id
    alphaTyVar], []) ([], [])
                            [] -- Arg tys
                            Kind
    alphaTy
                            (Id
    matcher_id, Bool
    True) Maybe (Id, Bool)
    forall a. Maybe a
    Nothing
                            []  -- Field labels
           where
             -- The matcher_id is used only by the desugarer, so actually
             -- and error-thunk would probably do just as well here.
             matcher_id :: Id
    matcher_id = HasDebugCallStack => Name -> Kind -> Kind -> Id
    Name -> Kind -> Kind -> Id
    mkLocalId Name
    matcher_name Kind
    Many (Kind -> Id) -> Kind -> Id
    forall a b. (a -> b) -> a -> b
    $
                          [Id] -> Kind -> Kind
    mkSpecForAllTys [Id
    alphaTyVar] Kind
    alphaTy

    {- Note [Pattern synonym error recovery]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If type inference for a pattern synonym fails, we can't continue with
    the rest of tc_patsyn_finish, because we may get knock-on errors, or
    even a crash.  E.g. from
       pattern What = True :: Maybe
    we get a kind error; and we must stop right away (#15289).

    We stop if there are /any/ unsolved constraints, not just insoluble
    ones; because pattern synonyms are top-level things, we will never
    solve them later if we can't solve them now.  And if we were to carry
    on, tc_patsyn_finish does zonkTcTypeToType, which defaults any
    unsolved unificatdion variables to Any, which confuses the error
    reporting no end (#15685).

    So we use simplifyTop to completely solve the constraint, report
    any errors, throw an exception.

    Even in the event of such an error we can recover and carry on, just
    as we do for value bindings, provided we plug in placeholder for the
    pattern synonym: see recoverPSB.  The goal of the placeholder is not
    to cause a raft of follow-on errors.  I've used the simplest thing for
    now, but we might need to elaborate it a bit later.  (e.g.  I've given
    it zero args, which may cause knock-on errors if it is used in a
    pattern.) But it'll do for now.

    -}

    tcInferPatSynDecl :: PatSynBind GhcRn GhcRn
                      -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl :: PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
    psb_id = lname :: GenLocated SrcSpan (IdP GhcRn)
    lname@(L SrcSpan
    _ IdP GhcRn
    name), psb_args :: forall idL idR.
    PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
    psb_args = HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details
                           , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
    psb_def = LPat GhcRn
    lpat, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
    psb_dir = HsPatSynDir GhcRn
    dir })
      = Located Name
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a. Located Name -> TcM a -> TcM a
    addPatSynCtxt Located Name
    GenLocated SrcSpan (IdP GhcRn)
    lname (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        do { String -> MsgDoc -> TcRn ()
    traceTc String
    "tcInferPatSynDecl {" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    name

           ; let ([Name]
    arg_names, [Name]
    rec_fields, Bool
    is_infix) = HsPatSynDetails (Located Name) -> ([Name], [Name], Bool)
    collectPatSynArgInfo HsPatSynDetails (Located Name)
    HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details
           ; (TcLevel
    tclvl, WantedConstraints
    wanted, ((Located (Pat GhcTc)
    lpat', [Id]
    args), Kind
    pat_ty))
                <- TcM ((Located (Pat GhcTc), [Id]), Kind)
    -> TcM
         (TcLevel, WantedConstraints, ((Located (Pat GhcTc), [Id]), Kind))
    forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints  (TcM ((Located (Pat GhcTc), [Id]), Kind)
     -> TcM
          (TcLevel, WantedConstraints, ((Located (Pat GhcTc), [Id]), Kind)))
    -> TcM ((Located (Pat GhcTc), [Id]), Kind)
    -> TcM
         (TcLevel, WantedConstraints, ((Located (Pat GhcTc), [Id]), Kind))
    forall a b. (a -> b) -> a -> b
    $
                   HsMatchContext GhcRn
    -> LPat GhcRn -> TcM [Id] -> TcM ((LPat GhcTc, [Id]), Kind)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> TcM a -> TcM ((LPat GhcTc, a), Kind)
    tcInferPat HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatSyn LPat GhcRn
    lpat          (TcM [Id] -> TcM ((LPat GhcTc, [Id]), Kind))
    -> TcM [Id] -> TcM ((LPat GhcTc, [Id]), Kind)
    forall a b. (a -> b) -> a -> b
    $
                   (Name -> IOEnv (Env TcGblEnv TcLclEnv) Id) -> [Name] -> TcM [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> IOEnv (Env TcGblEnv TcLclEnv) Id
    tcLookupId [Name]
    arg_names

           ; let ([Id]
    ex_tvs, [Id]
    prov_dicts) = LPat GhcTc -> ([Id], [Id])
    tcCollectEx Located (Pat GhcTc)
    LPat GhcTc
    lpat'

                 named_taus :: [(Name, Kind)]
    named_taus = (Name
    IdP GhcRn
    name, Kind
    pat_ty) (Name, Kind) -> [(Name, Kind)] -> [(Name, Kind)]
    forall a. a -> [a] -> [a]
    : (Id -> (Name, Kind)) -> [Id] -> [(Name, Kind)]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> (Name, Kind)
    mk_named_tau [Id]
    args
                 mk_named_tau :: Id -> (Name, Kind)
    mk_named_tau Id
    arg
                   = (Id -> Name
    forall a. NamedThing a => a -> Name
    getName Id
    arg, [Id] -> Kind -> Kind
    mkSpecForAllTys [Id]
    ex_tvs (Id -> Kind
    varType Id
    arg))
                   -- The mkSpecForAllTys is important (#14552), albeit
                   -- slightly artificial (there is no variable with this funny type).
                   -- We do not want to quantify over variable (alpha::k)
                   -- that mention the existentially-bound type variables
                   -- ex_tvs in its kind k.
                   -- See Note [Type variables whose kind is captured]

           ; ([Id]
    univ_tvs, [Id]
    req_dicts, TcEvBinds
    ev_binds, WantedConstraints
    residual, Bool
    _)
                   <- TcLevel
    -> InferMode
    -> [TcIdSigInst]
    -> [(Name, Kind)]
    -> WantedConstraints
    -> TcM ([Id], [Id], TcEvBinds, WantedConstraints, Bool)
    simplifyInfer TcLevel
    tclvl InferMode
    NoRestrictions [] [(Name, Kind)]
    named_taus WantedConstraints
    wanted
           ; Bag EvBind
    top_ev_binds <- TcM (Bag EvBind) -> TcM (Bag EvBind)
    forall r. TcM r -> TcM r
    checkNoErrs (WantedConstraints -> TcM (Bag EvBind)
    simplifyTop WantedConstraints
    residual)
           ; Bag EvBind
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a. Bag EvBind -> TcM a -> TcM a
    addTopEvBinds Bag EvBind
    top_ev_binds (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $

        do { [Id]
    prov_dicts <- (Id -> IOEnv (Env TcGblEnv TcLclEnv) Id) -> [Id] -> TcM [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
    zonkId [Id]
    prov_dicts
           ; let filtered_prov_dicts :: [Id]
    filtered_prov_dicts = (Id -> Kind) -> [Id] -> [Id]
    forall a. (a -> Kind) -> [a] -> [a]
    mkMinimalBySCs Id -> Kind
    evVarPred [Id]
    prov_dicts
                 -- Filtering: see Note [Remove redundant provided dicts]
                 ([Kind]
    prov_theta, [EvTerm]
    prov_evs)
                     = [(Kind, EvTerm)] -> ([Kind], [EvTerm])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ((Id -> Maybe (Kind, EvTerm)) -> [Id] -> [(Kind, EvTerm)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Id -> Maybe (Kind, EvTerm)
    mkProvEvidence [Id]
    filtered_prov_dicts)
                 req_theta :: [Kind]
    req_theta = (Id -> Kind) -> [Id] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Kind
    evVarPred [Id]
    req_dicts

           -- Report coercions that escape
           -- See Note [Coercions that escape]
           ; [Id]
    args <- (Id -> IOEnv (Env TcGblEnv TcLclEnv) Id) -> [Id] -> TcM [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Id -> IOEnv (Env TcGblEnv TcLclEnv) Id
    zonkId [Id]
    args
           ; let bad_args :: [(Id, DVarSet)]
    bad_args = [ (Id
    arg, DVarSet
    bad_cos) | Id
    arg <- [Id]
    args [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    prov_dicts
                                  , let bad_cos :: DVarSet
    bad_cos = (Id -> Bool) -> DVarSet -> DVarSet
    filterDVarSet Id -> Bool
    isId (DVarSet -> DVarSet) -> DVarSet -> DVarSet
    forall a b. (a -> b) -> a -> b
    $
                                                  (Kind -> DVarSet
    tyCoVarsOfTypeDSet (Id -> Kind
    idType Id
    arg))
                                  , Bool -> Bool
    not (DVarSet -> Bool
    isEmptyDVarSet DVarSet
    bad_cos) ]
           ; ((Id, DVarSet) -> TcRn ()) -> [(Id, DVarSet)] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Id, DVarSet) -> TcRn ()
    dependentArgErr [(Id, DVarSet)]
    bad_args

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcInferPatSynDecl }" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    name MsgDoc -> MsgDoc -> MsgDoc
    $$ [Id] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Id]
    ex_tvs)
           ; Located Name
    -> HsPatSynDir GhcRn
    -> Bool
    -> LPat GhcTc
    -> ([VarBndr Id Specificity], [Kind], TcEvBinds, [Id])
    -> ([VarBndr Id Specificity], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> [Name]
    -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish Located Name
    GenLocated SrcSpan (IdP GhcRn)
    lname HsPatSynDir GhcRn
    dir Bool
    is_infix Located (Pat GhcTc)
    LPat GhcTc
    lpat'
                              (Specificity -> [Id] -> [VarBndr Id Specificity]
    forall vis. vis -> [Id] -> [VarBndr Id vis]
    mkTyVarBinders Specificity
    InferredSpec [Id]
    univ_tvs
                                , [Kind]
    req_theta,  TcEvBinds
    ev_binds, [Id]
    req_dicts)
                              (Specificity -> [Id] -> [VarBndr Id Specificity]
    forall vis. vis -> [Id] -> [VarBndr Id vis]
    mkTyVarBinders Specificity
    InferredSpec [Id]
    ex_tvs
                                , [Id] -> [Kind]
    mkTyVarTys [Id]
    ex_tvs, [Kind]
    prov_theta, [EvTerm]
    prov_evs)
                              ((Id -> LHsExpr GhcTc) -> [Id] -> [LHsExpr GhcTc]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar [Id]
    args, (Id -> Kind) -> [Id] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Kind
    idType [Id]
    args)
                              Kind
    pat_ty [Name]
    rec_fields } }

    mkProvEvidence :: EvId -> Maybe (PredType, EvTerm)
    -- See Note [Equality evidence in pattern synonyms]
    mkProvEvidence :: Id -> Maybe (Kind, EvTerm)
    mkProvEvidence Id
    ev_id
      | EqPred EqRel
    r Kind
    ty1 Kind
    ty2 <- Kind -> Pred
    classifyPredType Kind
    pred
      , let k1 :: Kind
    k1 = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    tcTypeKind Kind
    ty1
            k2 :: Kind
    k2 = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    tcTypeKind Kind
    ty2
            is_homo :: Bool
    is_homo = Kind
    k1 HasDebugCallStack => Kind -> Kind -> Bool
    Kind -> Kind -> Bool
    `tcEqType` Kind
    k2
            homo_tys :: [Kind]
    homo_tys   = [Kind
    k1, Kind
    ty1, Kind
    ty2]
            hetero_tys :: [Kind]
    hetero_tys = [Kind
    k1, Kind
    k2, Kind
    ty1, Kind
    ty2]
      = case EqRel
    r of
          EqRel
    ReprEq | Bool
    is_homo
                 -> (Kind, EvTerm) -> Maybe (Kind, EvTerm)
    forall a. a -> Maybe a
    Just ( Class -> [Kind] -> Kind
    mkClassPred Class
    coercibleClass    [Kind]
    homo_tys
                         , DataCon -> [Kind] -> [EvExpr] -> EvTerm
    evDataConApp DataCon
    coercibleDataCon [Kind]
    homo_tys [EvExpr]
    eq_con_args )
                 | Bool
    otherwise -> Maybe (Kind, EvTerm)
    forall a. Maybe a
    Nothing
          EqRel
    NomEq  | Bool
    is_homo
                 -> (Kind, EvTerm) -> Maybe (Kind, EvTerm)
    forall a. a -> Maybe a
    Just ( Class -> [Kind] -> Kind
    mkClassPred Class
    eqClass    [Kind]
    homo_tys
                         , DataCon -> [Kind] -> [EvExpr] -> EvTerm
    evDataConApp DataCon
    eqDataCon [Kind]
    homo_tys [EvExpr]
    eq_con_args )
                 | Bool
    otherwise
                 -> (Kind, EvTerm) -> Maybe (Kind, EvTerm)
    forall a. a -> Maybe a
    Just ( Class -> [Kind] -> Kind
    mkClassPred Class
    heqClass    [Kind]
    hetero_tys
                         , DataCon -> [Kind] -> [EvExpr] -> EvTerm
    evDataConApp DataCon
    heqDataCon [Kind]
    hetero_tys [EvExpr]
    eq_con_args )

      | Bool
    otherwise
      = (Kind, EvTerm) -> Maybe (Kind, EvTerm)
    forall a. a -> Maybe a
    Just (Kind
    pred, EvExpr -> EvTerm
    EvExpr (Id -> EvExpr
    evId Id
    ev_id))
      where
        pred :: Kind
    pred = Id -> Kind
    evVarPred Id
    ev_id
        eq_con_args :: [EvExpr]
    eq_con_args = [Id -> EvExpr
    evId Id
    ev_id]

    dependentArgErr :: (Id, DTyCoVarSet) -> TcM ()
    -- See Note [Coercions that escape]
    dependentArgErr :: (Id, DVarSet) -> TcRn ()
    dependentArgErr (Id
    arg, DVarSet
    bad_cos)
      = MsgDoc -> TcRn ()
    addErrTc (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
        [MsgDoc] -> MsgDoc
    vcat [ String -> MsgDoc
    text String
    "Iceland Jack!  Iceland Jack! Stop torturing me!"
             , MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Pattern-bound variable")
                  Int
    2 (Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Id
    arg MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    dcolon MsgDoc -> MsgDoc -> MsgDoc
    <+> Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Id -> Kind
    idType Id
    arg))
             , Int -> MsgDoc -> MsgDoc
    nest Int
    2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
    forall a b. (a -> b) -> a -> b
    $
               MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "has a type that mentions pattern-bound coercion"
                     MsgDoc -> MsgDoc -> MsgDoc
    <> [Id] -> MsgDoc
    forall a. [a] -> MsgDoc
    plural [Id]
    bad_co_list MsgDoc -> MsgDoc -> MsgDoc
    <> MsgDoc
    colon)
                  Int
    2 ((Id -> MsgDoc) -> [Id] -> MsgDoc
    forall a. (a -> MsgDoc) -> [a] -> MsgDoc
    pprWithCommas Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Id]
    bad_co_list)
             , String -> MsgDoc
    text String
    "Hint: use -fprint-explicit-coercions to see the coercions"
             , String -> MsgDoc
    text String
    "Probable fix: add a pattern signature" ]
      where
        bad_co_list :: [Id]
    bad_co_list = DVarSet -> [Id]
    dVarSetElems DVarSet
    bad_cos

    {- Note [Type variables whose kind is captured]
    ~~-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data AST a = Sym [a]
      class Prj s where { prj :: [a] -> Maybe (s a) }
      pattern P x <= Sym (prj -> Just x)

    Here we get a matcher with this type
      $mP :: forall s a. Prj s => AST a -> (s a -> r) -> r -> r

    No problem.  But note that 's' is not fixed by the type of the
    pattern (AST a), nor is it existentially bound.  It's really only
    fixed by the type of the continuation.

    #14552 showed that this can go wrong if the kind of 's' mentions
    existentially bound variables.  We obviously can't make a type like
      $mP :: forall (s::k->*) a. Prj s => AST a -> (forall k. s a -> r)
                                       -> r -> r
    But neither is 's' itself existentially bound, so the forall (s::k->*)
    can't go in the inner forall either.  (What would the matcher apply
    the continuation to?)

    Solution: do not quantiify over any unification variable whose kind
    mentions the existentials.  We can conveniently do that by making the
    "taus" passed to simplifyInfer look like
       forall ex_tvs. arg_ty

    After that, Note [Naughty quantification candidates] in GHC.Tc.Utils.TcMType takes
    over and errors.

    Note [Remove redundant provided dicts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Recall that
       HRefl :: forall k1 k2 (a1:k1) (a2:k2). (k1 ~ k2, a1 ~ a2)
                                           => a1 :~~: a2
    (NB: technically the (k1~k2) existential dictionary is not necessary,
    but it's there at the moment.)

    Now consider (#14394):
       pattern Foo = HRefl
    in a non-poly-kinded module.  We don't want to get
        pattern Foo :: () => (* ~ *, b ~ a) => a :~~: b
    with that redundant (* ~ *).  We'd like to remove it; hence the call to
    mkMinimalWithSCs.

    Similarly consider
      data S a where { MkS :: Ord a => a -> S a }
      pattern Bam x y <- (MkS (x::a), MkS (y::a)))

    The pattern (Bam x y) binds two (Ord a) dictionaries, but we only
    need one.  Again mkMimimalWithSCs removes the redundant one.

    Note [Equality evidence in pattern synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data X a where
         MkX :: Eq a => [a] -> X (Maybe a)
      pattern P x = MkG x

    Then there is a danger that GHC will infer
      P :: forall a.  () =>
           forall b. (a ~# Maybe b, Eq b) => [b] -> X a

    The 'builder' for P, which is called in user-code, will then
    have type
      $bP :: forall a b. (a ~# Maybe b, Eq b) => [b] -> X a

    and that is bad because (a ~# Maybe b) is not a predicate type
    (see Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep
    and is not implicitly instantiated.

    So in mkProvEvidence we lift (a ~# b) to (a ~ b).  Tiresome, and
    marginally less efficient, if the builder/martcher are not inlined.

    See also Note [Lift equality constraints when quantifying] in GHC.Tc.Utils.TcType

    Note [Coercions that escape]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #14507 showed an example where the inferred type of the matcher
    for the pattern synonym was something like
       $mSO :: forall (r :: TYPE rep) kk (a :: k).
               TypeRep k a
               -> ((Bool ~ k) => TypeRep Bool (a |> co_a2sv) -> r)
               -> (Void# -> r)
               -> r

    What is that co_a2sv :: Bool ~# *??  It was bound (via a superclass
    selection) by the pattern being matched; and indeed it is implicit in
    the context (Bool ~ k).  You could imagine trying to extract it like
    this:
       $mSO :: forall (r :: TYPE rep) kk (a :: k).
               TypeRep k a
               -> ( co :: ((Bool :: *) ~ (k :: *)) =>
                      let co_a2sv = sc_sel co
                      in TypeRep Bool (a |> co_a2sv) -> r)
               -> (Void# -> r)
               -> r

    But we simply don't allow that in types.  Maybe one day but not now.

    How to detect this situation?  We just look for free coercion variables
    in the types of any of the arguments to the matcher.  The error message
    is not very helpful, but at least we don't get a Lint error.
    -}

    tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn
                      -> TcPatSynInfo
                      -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn
    -> TcPatSynInfo -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl psb :: PatSynBind GhcRn GhcRn
    psb@PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
    psb_id = lname :: GenLocated SrcSpan (IdP GhcRn)
    lname@(L SrcSpan
    _ IdP GhcRn
    name), psb_args :: forall idL idR.
    PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
    psb_args = HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details
                             , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
    psb_def = LPat GhcRn
    lpat, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
    psb_dir = HsPatSynDir GhcRn
    dir }
                      TPSI{ patsig_implicit_bndrs :: TcPatSynInfo -> [VarBndr Id Specificity]
    patsig_implicit_bndrs = [VarBndr Id Specificity]
    implicit_bndrs
                          , patsig_univ_bndrs :: TcPatSynInfo -> [VarBndr Id Specificity]
    patsig_univ_bndrs = [VarBndr Id Specificity]
    explicit_univ_bndrs, patsig_prov :: TcPatSynInfo -> [Kind]
    patsig_prov = [Kind]
    prov_theta
                          , patsig_ex_bndrs :: TcPatSynInfo -> [VarBndr Id Specificity]
    patsig_ex_bndrs   = [VarBndr Id Specificity]
    explicit_ex_bndrs,   patsig_req :: TcPatSynInfo -> [Kind]
    patsig_req  = [Kind]
    req_theta
                          , patsig_body_ty :: TcPatSynInfo -> Kind
    patsig_body_ty    = Kind
    sig_body_ty }
      = Located Name
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a. Located Name -> TcM a -> TcM a
    addPatSynCtxt Located Name
    GenLocated SrcSpan (IdP GhcRn)
    lname (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        do { let decl_arity :: Int
    decl_arity = [Name] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    arg_names
                 ([Name]
    arg_names, [Name]
    rec_fields, Bool
    is_infix) = HsPatSynDetails (Located Name) -> ([Name], [Name], Bool)
    collectPatSynArgInfo HsPatSynDetails (Located Name)
    HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcCheckPatSynDecl" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             [MsgDoc] -> MsgDoc
    vcat [ [VarBndr Id Specificity] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [VarBndr Id Specificity]
    implicit_bndrs, [VarBndr Id Specificity] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [VarBndr Id Specificity]
    explicit_univ_bndrs, [Kind] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Kind]
    req_theta
                  , [VarBndr Id Specificity] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [VarBndr Id Specificity]
    explicit_ex_bndrs, [Kind] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Kind]
    prov_theta, Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Kind
    sig_body_ty ]

           ; ([Scaled Kind]
    arg_tys, Kind
    pat_ty) <- case Int -> Kind -> Either Int ([Scaled Kind], Kind)
    tcSplitFunTysN Int
    decl_arity Kind
    sig_body_ty of
                                     Right ([Scaled Kind], Kind)
    stuff  -> ([Scaled Kind], Kind)
    -> IOEnv (Env TcGblEnv TcLclEnv) ([Scaled Kind], Kind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Scaled Kind], Kind)
    stuff
                                     Left Int
    missing -> Name
    -> Int
    -> Int
    -> IOEnv (Env TcGblEnv TcLclEnv) ([Scaled Kind], Kind)
    forall a. Name -> Int -> Int -> TcM a
    wrongNumberOfParmsErr Name
    IdP GhcRn
    name Int
    decl_arity Int
    missing

           -- Complain about:  pattern P :: () => forall x. x -> P x
           -- The existential 'x' should not appear in the result type
           -- Can't check this until we know P's arity
           ; let bad_tvs :: [Id]
    bad_tvs = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Id -> VarSet -> Bool
    `elemVarSet` Kind -> VarSet
    tyCoVarsOfType Kind
    pat_ty) ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    explicit_ex_bndrs
           ; Bool -> MsgDoc -> TcRn ()
    checkTc ([Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    bad_tvs) (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang ([MsgDoc] -> MsgDoc
    sep [ String -> MsgDoc
    text String
    "The result type of the signature for" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    name) MsgDoc -> MsgDoc -> MsgDoc
    <> MsgDoc
    comma
                       , String -> MsgDoc
    text String
    "namely" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Kind
    pat_ty) ])
                Int
    2 (String -> MsgDoc
    text String
    "mentions existential type variable" MsgDoc -> MsgDoc -> MsgDoc
    <> [Id] -> MsgDoc
    forall a. [a] -> MsgDoc
    plural [Id]
    bad_tvs
                   MsgDoc -> MsgDoc -> MsgDoc
    <+> [Id] -> MsgDoc
    forall a. Outputable a => [a] -> MsgDoc
    pprQuotedList [Id]
    bad_tvs)

             -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig
           ; let univ_fvs :: VarSet
    univ_fvs = VarSet -> VarSet
    closeOverKinds (VarSet -> VarSet) -> VarSet -> VarSet
    forall a b. (a -> b) -> a -> b
    $
                            ([Kind] -> VarSet
    tyCoVarsOfTypes (Kind
    pat_ty Kind -> [Kind] -> [Kind]
    forall a. a -> [a] -> [a]
    : [Kind]
    req_theta) VarSet -> [Id] -> VarSet
    `extendVarSetList` ([VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    explicit_univ_bndrs))
                 ([VarBndr Id Specificity]
    extra_univ, [VarBndr Id Specificity]
    extra_ex) = (VarBndr Id Specificity -> Bool)
    -> [VarBndr Id Specificity]
    -> ([VarBndr Id Specificity], [VarBndr Id Specificity])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((Id -> VarSet -> Bool
    `elemVarSet` VarSet
    univ_fvs) (Id -> Bool)
    -> (VarBndr Id Specificity -> Id) -> VarBndr Id Specificity -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarBndr Id Specificity -> Id
    forall tv argf. VarBndr tv argf -> tv
    binderVar) [VarBndr Id Specificity]
    implicit_bndrs
                 univ_bndrs :: [VarBndr Id Specificity]
    univ_bndrs = [VarBndr Id Specificity]
    extra_univ [VarBndr Id Specificity]
    -> [VarBndr Id Specificity] -> [VarBndr Id Specificity]
    forall a. [a] -> [a] -> [a]
    ++ [VarBndr Id Specificity]
    explicit_univ_bndrs
                 ex_bndrs :: [VarBndr Id Specificity]
    ex_bndrs   = [VarBndr Id Specificity]
    extra_ex   [VarBndr Id Specificity]
    -> [VarBndr Id Specificity] -> [VarBndr Id Specificity]
    forall a. [a] -> [a] -> [a]
    ++ [VarBndr Id Specificity]
    explicit_ex_bndrs
                 univ_tvs :: [Id]
    univ_tvs   = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    univ_bndrs
                 ex_tvs :: [Id]
    ex_tvs     = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    ex_bndrs

           -- Right!  Let's check the pattern against the signature
           -- See Note [Checking against a pattern signature]
           ; [Id]
    req_dicts <- [Kind] -> TcM [Id]
    newEvVars [Kind]
    req_theta
           ; (TcLevel
    tclvl, WantedConstraints
    wanted, (Located (Pat GhcTc)
    lpat', ([Id]
    ex_tvs', [EvTerm]
    prov_dicts, [LHsExpr GhcTc]
    args'))) <-
               ASSERT2( equalLength arg_names arg_tys, ppr name $$ ppr arg_names $$ ppr arg_tys )
               TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TcLevel, WantedConstraints,
          (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc])))
    forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints   (TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (TcLevel, WantedConstraints,
           (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))))
    -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TcLevel, WantedConstraints,
          (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc])))
    forall a b. (a -> b) -> a -> b
    $
               [Id]
    -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    forall r. [Id] -> TcM r -> TcM r
    tcExtendTyVarEnv [Id]
    univ_tvs        (TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
     -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc])))
    -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    -> TcM (Located (Pat GhcTc), ([Id], [EvTerm], [LHsExpr GhcTc]))
    forall a b. (a -> b) -> a -> b
    $
               HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled Kind
    -> TcM ([Id], [EvTerm], [LHsExpr GhcTc])
    -> TcM (LPat GhcTc, ([Id], [EvTerm], [LHsExpr GhcTc]))
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Kind -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatSyn LPat GhcRn
    lpat (Kind -> Scaled Kind
    forall a. a -> Scaled a
    unrestricted Kind
    pat_ty)   (TcM ([Id], [EvTerm], [LHsExpr GhcTc])
     -> TcM (LPat GhcTc, ([Id], [EvTerm], [LHsExpr GhcTc])))
    -> TcM ([Id], [EvTerm], [LHsExpr GhcTc])
    -> TcM (LPat GhcTc, ([Id], [EvTerm], [LHsExpr GhcTc]))
    forall a b. (a -> b) -> a -> b
    $
               do { let in_scope :: InScopeSet
    in_scope    = VarSet -> InScopeSet
    mkInScopeSet ([Id] -> VarSet
    mkVarSet [Id]
    univ_tvs)
                        empty_subst :: TCvSubst
    empty_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst InScopeSet
    in_scope
                  ; (TCvSubst
    subst, [Id]
    ex_tvs') <- (TCvSubst -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (TCvSubst, Id))
    -> TCvSubst
    -> [Id]
    -> IOEnv (Env TcGblEnv TcLclEnv) (TCvSubst, [Id])
    forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM TCvSubst -> Id -> IOEnv (Env TcGblEnv TcLclEnv) (TCvSubst, Id)
    newMetaTyVarX TCvSubst
    empty_subst [Id]
    ex_tvs
                        -- newMetaTyVarX: see the "Existential type variables"
                        -- part of Note [Checking against a pattern signature]
                  ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcpatsyn1" ([MsgDoc] -> MsgDoc
    vcat [ Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Id
    v MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    dcolon MsgDoc -> MsgDoc -> MsgDoc
    <+> Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Id -> Kind
    tyVarKind Id
    v) | Id
    v <- [Id]
    ex_tvs])
                  ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcpatsyn2" ([MsgDoc] -> MsgDoc
    vcat [ Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Id
    v MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    dcolon MsgDoc -> MsgDoc -> MsgDoc
    <+> Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Id -> Kind
    tyVarKind Id
    v) | Id
    v <- [Id]
    ex_tvs'])
                  ; let prov_theta' :: [Kind]
    prov_theta' = HasCallStack => TCvSubst -> [Kind] -> [Kind]
    TCvSubst -> [Kind] -> [Kind]
    substTheta TCvSubst
    subst [Kind]
    prov_theta
                      -- Add univ_tvs to the in_scope set to
                      -- satisfy the substitution invariant. There's no need to
                      -- add 'ex_tvs' as they are already in the domain of the
                      -- substitution.
                      -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst.
                  ; [EvTerm]
    prov_dicts <- (Kind -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm)
    -> [Kind] -> IOEnv (Env TcGblEnv TcLclEnv) [EvTerm]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (CtOrigin -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) EvTerm
    emitWanted (PatSynBind GhcRn GhcRn -> CtOrigin
    ProvCtxtOrigin PatSynBind GhcRn GhcRn
    psb)) [Kind]
    prov_theta'
                  ; [LHsExpr GhcTc]
    args'      <- (Name -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcTc))
    -> [Name]
    -> [Kind]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsExpr GhcTc]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (TCvSubst
    -> Name -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcTc)
    tc_arg TCvSubst
    subst) [Name]
    arg_names ((Scaled Kind -> Kind) -> [Scaled Kind] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Kind -> Kind
    forall a. Scaled a -> a
    scaledThing [Scaled Kind]
    arg_tys)
                  ; ([Id], [EvTerm], [LHsExpr GhcTc])
    -> TcM ([Id], [EvTerm], [LHsExpr GhcTc])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ex_tvs', [EvTerm]
    prov_dicts, [LHsExpr GhcTc]
    args') }

           ; let skol_info :: SkolemInfo
    skol_info = UserTypeCtxt -> Kind -> [(Name, Id)] -> SkolemInfo
    SigSkol (Name -> UserTypeCtxt
    PatSynCtxt Name
    IdP GhcRn
    name) Kind
    pat_ty []
                             -- The type here is a bit bogus, but we do not print
                             -- the type for PatSynCtxt, so it doesn't matter
                             -- See Note [Skolem info for pattern synonyms] in "GHC.Tc.Types.Origin"
           ; (Bag Implication
    implics, TcEvBinds
    ev_binds) <- TcLevel
    -> SkolemInfo
    -> [Id]
    -> [Id]
    -> WantedConstraints
    -> TcM (Bag Implication, TcEvBinds)
    buildImplicationFor TcLevel
    tclvl SkolemInfo
    skol_info [Id]
    univ_tvs [Id]
    req_dicts WantedConstraints
    wanted

           -- Solve the constraints now, because we are about to make a PatSyn,
           -- which should not contain unification variables and the like (#10997)
           ; Bag Implication -> TcRn ()
    simplifyTopImplic Bag Implication
    implics

           -- ToDo: in the bidirectional case, check that the ex_tvs' are all distinct
           -- Otherwise we may get a type error when typechecking the builder,
           -- when that should be impossible

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcCheckPatSynDecl }" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    name
           ; Located Name
    -> HsPatSynDir GhcRn
    -> Bool
    -> LPat GhcTc
    -> ([VarBndr Id Specificity], [Kind], TcEvBinds, [Id])
    -> ([VarBndr Id Specificity], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> [Name]
    -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish Located Name
    GenLocated SrcSpan (IdP GhcRn)
    lname HsPatSynDir GhcRn
    dir Bool
    is_infix Located (Pat GhcTc)
    LPat GhcTc
    lpat'
                              ([VarBndr Id Specificity]
    univ_bndrs, [Kind]
    req_theta, TcEvBinds
    ev_binds, [Id]
    req_dicts)
                              ([VarBndr Id Specificity]
    ex_bndrs, [Id] -> [Kind]
    mkTyVarTys [Id]
    ex_tvs', [Kind]
    prov_theta, [EvTerm]
    prov_dicts)
                              ([LHsExpr GhcTc]
    args', ((Scaled Kind -> Kind) -> [Scaled Kind] -> [Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Kind -> Kind
    forall a. Scaled a -> a
    scaledThing [Scaled Kind]
    arg_tys))
                              Kind
    pat_ty [Name]
    rec_fields }
      where
        tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTc)
        tc_arg :: TCvSubst
    -> Name -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcTc)
    tc_arg TCvSubst
    subst Name
    arg_name Kind
    arg_ty
          = do {   -- Look up the variable actually bound by lpat
                   -- and check that it has the expected type
                 Id
    arg_id <- Name -> IOEnv (Env TcGblEnv TcLclEnv) Id
    tcLookupId Name
    arg_name
               ; HsWrapper
    wrap <- UserTypeCtxt -> Kind -> Kind -> TcM HsWrapper
    tcSubTypeSigma UserTypeCtxt
    GenSigCtxt
                                        (Id -> Kind
    idType Id
    arg_id)
                                        (TCvSubst -> Kind -> Kind
    substTyUnchecked TCvSubst
    subst Kind
    arg_ty)
                    -- Why do we need tcSubType here?
                    -- See Note [Pattern synonyms and higher rank types]
               ; LHsExpr GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    wrap (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    arg_id) }

    {- [Pattern synonyms and higher rank types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data T = MkT (forall a. a->a)

      pattern P :: (Int -> Int) -> T
      pattern P x <- MkT x

    This should work.  But in the matcher we must match against MkT, and then
    instantiate its argument 'x', to get a function of type (Int -> Int).
    Equality is not enough!  #13752 was an example.

    Note [The pattern-synonym signature splitting rule]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Given a pattern signature, we must split
         the kind-generalised variables, and
         the implicitly-bound variables
    into universal and existential.  The rule is this
    (see discussion on #11224):

         The universal tyvars are the ones mentioned in
              - univ_tvs: the user-specified (forall'd) universals
              - req_theta
              - res_ty
         The existential tyvars are all the rest

    For example

       pattern P :: () => b -> T a
       pattern P x = ...

    Here 'a' is universal, and 'b' is existential.  But there is a wrinkle:
    how do we split the arg_tys from req_ty?  Consider

       pattern Q :: () => b -> S c -> T a
       pattern Q x = ...

    This is an odd example because Q has only one syntactic argument, and
    so presumably is defined by a view pattern matching a function.  But
    it can happen (#11977, #12108).

    We don't know Q's arity from the pattern signature, so we have to wait
    until we see the pattern declaration itself before deciding res_ty is,
    and hence which variables are existential and which are universal.

    And that in turn is why TcPatSynInfo has a separate field,
    patsig_implicit_bndrs, to capture the implicitly bound type variables,
    because we don't yet know how to split them up.

    It's a slight compromise, because it means we don't really know the
    pattern synonym's real signature until we see its declaration.  So,
    for example, in hs-boot file, we may need to think what to do...
    (eg don't have any implicitly-bound variables).

    Note [Checking against a pattern signature]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When checking the actual supplied pattern against the pattern synonym
    signature, we need to be quite careful.

    ----- Provided constraints
    Example

        data T a where
          MkT :: Ord a => a -> T a

        pattern P :: () => Eq a => a -> [T a]
        pattern P x = [MkT x]

    We must check that the (Eq a) that P claims to bind (and to
    make available to matches against P), is derivable from the
    actual pattern.  For example:
        f (P (x::a)) = ...here (Eq a) should be available...
    And yes, (Eq a) is derivable from the (Ord a) bound by P's rhs.

    ----- Existential type variables
    Unusually, we instantiate the existential tyvars of the pattern with
    *meta* type variables.  For example

        data S where
          MkS :: Eq a => [a] -> S

        pattern P :: () => Eq x => x -> S
        pattern P x <- MkS x

    The pattern synonym conceals from its client the fact that MkS has a
    list inside it.  The client just thinks it's a type 'x'.  So we must
    unify x := [a] during type checking, and then use the instantiating type
    [a] (called ex_tys) when building the matcher.  In this case we'll get

       $mP :: S -> (forall x. Ex x => x -> r) -> r -> r
       $mP x k = case x of
                   MkS a (d:Eq a) (ys:[a]) -> let dl :: Eq [a]
                                                  dl = $dfunEqList d
                                              in k [a] dl ys

    All this applies when type-checking the /matching/ side of
    a pattern synonym.  What about the /building/ side?

    * For Unidirectional, there is no builder

    * For ExplicitBidirectional, the builder is completely separate
      code, typechecked in tcPatSynBuilderBind

    * For ImplicitBidirectional, the builder is still typechecked in
      tcPatSynBuilderBind, by converting the pattern to an expression and
      typechecking it.

      At one point, for ImplicitBidirectional I used TyVarTvs (instead of
      TauTvs) in tcCheckPatSynDecl.  But (a) strengthening the check here
      is redundant since tcPatSynBuilderBind does the job, (b) it was
      still incomplete (TyVarTvs can unify with each other), and (c) it
      didn't even work (#13441 was accepted with
      ExplicitBidirectional, but rejected if expressed in
      ImplicitBidirectional form.  Conclusion: trying to be too clever is
      a bad idea.
    -}

    collectPatSynArgInfo :: HsPatSynDetails (Located Name)
                         -> ([Name], [Name], Bool)
    collectPatSynArgInfo :: HsPatSynDetails (Located Name) -> ([Name], [Name], Bool)
    collectPatSynArgInfo HsPatSynDetails (Located Name)
    details =
      case HsPatSynDetails (Located Name)
    details of
        PrefixCon [Located Name]
    names      -> ((Located Name -> Name) -> [Located Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [Located Name]
    names, [], Bool
    False)
        InfixCon Located Name
    name1 Located Name
    name2 -> ((Located Name -> Name) -> [Located Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [Located Name
    name1, Located Name
    name2], [], Bool
    True)
        RecCon [RecordPatSynField (Located Name)]
    names         -> ([Name]
    vars, [Name]
    sels, Bool
    False)
                             where
                                ([Name]
    vars, [Name]
    sels) = [(Name, Name)] -> ([Name], [Name])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ((RecordPatSynField (Located Name) -> (Name, Name))
    -> [RecordPatSynField (Located Name)] -> [(Name, Name)]
    forall a b. (a -> b) -> [a] -> [b]
    map RecordPatSynField (Located Name) -> (Name, Name)
    splitRecordPatSyn [RecordPatSynField (Located Name)]
    names)
      where
        splitRecordPatSyn :: RecordPatSynField (Located Name)
                          -> (Name, Name)
        splitRecordPatSyn :: RecordPatSynField (Located Name) -> (Name, Name)
    splitRecordPatSyn (RecordPatSynField
                           { recordPatSynPatVar :: forall a. RecordPatSynField a -> a
    recordPatSynPatVar     = L SrcSpan
    _ Name
    patVar
                           , recordPatSynSelectorId :: forall a. RecordPatSynField a -> a
    recordPatSynSelectorId = L SrcSpan
    _ Name
    selId })
          = (Name
    patVar, Name
    selId)

    addPatSynCtxt :: Located Name -> TcM a -> TcM a
    addPatSynCtxt :: forall a. Located Name -> TcM a -> TcM a
    addPatSynCtxt (L SrcSpan
    loc Name
    name) TcM a
    thing_inside
      = SrcSpan -> TcM a -> TcM a
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        MsgDoc -> TcM a -> TcM a
    forall a. MsgDoc -> TcM a -> TcM a
    addErrCtxt (String -> MsgDoc
    text String
    "In the declaration for pattern synonym"
                    MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    name)) (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        TcM a
    thing_inside

    wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
    wrongNumberOfParmsErr :: forall a. Name -> Int -> Int -> TcM a
    wrongNumberOfParmsErr Name
    name Int
    decl_arity Int
    missing
      = MsgDoc -> TcM a
    forall a. MsgDoc -> TcM a
    failWithTc (MsgDoc -> TcM a) -> MsgDoc -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Pattern synonym" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    name) MsgDoc -> MsgDoc -> MsgDoc
    <+> PtrString -> MsgDoc
    ptext (String -> PtrString
    sLit String
    "has")
              MsgDoc -> MsgDoc -> MsgDoc
    <+> Int -> MsgDoc -> MsgDoc
    speakNOf Int
    decl_arity (String -> MsgDoc
    text String
    "argument"))
           Int
    2 (String -> MsgDoc
    text String
    "but its type signature has" MsgDoc -> MsgDoc -> MsgDoc
    <+> Int -> MsgDoc
    int Int
    missing MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "fewer arrows")

    -------------------------
    -- Shared by both tcInferPatSyn and tcCheckPatSyn
    tc_patsyn_finish :: Located Name      -- ^ PatSyn Name
                     -> HsPatSynDir GhcRn -- ^ PatSyn type (Uni/Bidir/ExplicitBidir)
                     -> Bool              -- ^ Whether infix
                     -> LPat GhcTc        -- ^ Pattern of the PatSyn
                     -> ([TcInvisTVBinder], [PredType], TcEvBinds, [EvVar])
                     -> ([TcInvisTVBinder], [TcType], [PredType], [EvTerm])
                     -> ([LHsExpr GhcTc], [TcType])  -- ^ Pattern arguments and types
                     -> TcType            -- ^ Pattern type
                     -> [Name]            -- ^ Selector names
                     -- ^ Whether fields, empty if not record PatSyn
                     -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish :: Located Name
    -> HsPatSynDir GhcRn
    -> Bool
    -> LPat GhcTc
    -> ([VarBndr Id Specificity], [Kind], TcEvBinds, [Id])
    -> ([VarBndr Id Specificity], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> [Name]
    -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish Located Name
    lname HsPatSynDir GhcRn
    dir Bool
    is_infix LPat GhcTc
    lpat'
                     ([VarBndr Id Specificity]
    univ_tvs, [Kind]
    req_theta, TcEvBinds
    req_ev_binds, [Id]
    req_dicts)
                     ([VarBndr Id Specificity]
    ex_tvs,   [Kind]
    ex_tys,    [Kind]
    prov_theta,   [EvTerm]
    prov_dicts)
                     ([LHsExpr GhcTc]
    args, [Kind]
    arg_tys)
                     Kind
    pat_ty [Name]
    field_labels
      = do { -- Zonk everything.  We are about to build a final PatSyn
             -- so there had better be no unification variables in there

             (ZonkEnv
    ze, [VarBndr Id Specificity]
    univ_tvs') <- [VarBndr Id Specificity] -> TcM (ZonkEnv, [VarBndr Id Specificity])
    forall vis. [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
    zonkTyVarBinders [VarBndr Id Specificity]
    univ_tvs
           ; [Kind]
    req_theta'      <- ZonkEnv -> [Kind] -> TcM [Kind]
    zonkTcTypesToTypesX ZonkEnv
    ze [Kind]
    req_theta
           ; (ZonkEnv
    ze, [VarBndr Id Specificity]
    ex_tvs')   <- ZonkEnv
    -> [VarBndr Id Specificity]
    -> TcM (ZonkEnv, [VarBndr Id Specificity])
    forall vis.
    ZonkEnv -> [VarBndr Id vis] -> TcM (ZonkEnv, [VarBndr Id vis])
    zonkTyVarBindersX ZonkEnv
    ze [VarBndr Id Specificity]
    ex_tvs
           ; [Kind]
    prov_theta'     <- ZonkEnv -> [Kind] -> TcM [Kind]
    zonkTcTypesToTypesX ZonkEnv
    ze [Kind]
    prov_theta
           ; Kind
    pat_ty'         <- ZonkEnv -> Kind -> TcM Kind
    zonkTcTypeToTypeX ZonkEnv
    ze Kind
    pat_ty
           ; [Kind]
    arg_tys'        <- ZonkEnv -> [Kind] -> TcM [Kind]
    zonkTcTypesToTypesX ZonkEnv
    ze [Kind]
    arg_tys

           ; let (TidyEnv
    env1, [VarBndr Id Specificity]
    univ_tvs) = TidyEnv
    -> [VarBndr Id Specificity] -> (TidyEnv, [VarBndr Id Specificity])
    forall vis.
    TidyEnv -> [VarBndr Id vis] -> (TidyEnv, [VarBndr Id vis])
    tidyTyCoVarBinders TidyEnv
    emptyTidyEnv [VarBndr Id Specificity]
    univ_tvs'
                 (TidyEnv
    env2, [VarBndr Id Specificity]
    ex_tvs)   = TidyEnv
    -> [VarBndr Id Specificity] -> (TidyEnv, [VarBndr Id Specificity])
    forall vis.
    TidyEnv -> [VarBndr Id vis] -> (TidyEnv, [VarBndr Id vis])
    tidyTyCoVarBinders TidyEnv
    env1 [VarBndr Id Specificity]
    ex_tvs'
                 req_theta :: [Kind]
    req_theta  = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    req_theta'
                 prov_theta :: [Kind]
    prov_theta = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    prov_theta'
                 arg_tys :: [Kind]
    arg_tys    = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    arg_tys'
                 pat_ty :: Kind
    pat_ty     = TidyEnv -> Kind -> Kind
    tidyType  TidyEnv
    env2 Kind
    pat_ty'

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tc_patsyn_finish {" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
               Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc Located Name
    lname) MsgDoc -> MsgDoc -> MsgDoc
    $$ Pat GhcTc -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Located (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc Located (Pat GhcTc)
    LPat GhcTc
    lpat') MsgDoc -> MsgDoc -> MsgDoc
    $$
               ([VarBndr Id Specificity], [Kind], TcEvBinds, [Id]) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr ([VarBndr Id Specificity]
    univ_tvs, [Kind]
    req_theta, TcEvBinds
    req_ev_binds, [Id]
    req_dicts) MsgDoc -> MsgDoc -> MsgDoc
    $$
               ([VarBndr Id Specificity], [Kind], [EvTerm]) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr ([VarBndr Id Specificity]
    ex_tvs, [Kind]
    prov_theta, [EvTerm]
    prov_dicts) MsgDoc -> MsgDoc -> MsgDoc
    $$
               [LHsExpr GhcTc] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [LHsExpr GhcTc]
    args MsgDoc -> MsgDoc -> MsgDoc
    $$
               [Kind] -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Kind]
    arg_tys MsgDoc -> MsgDoc -> MsgDoc
    $$
               Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Kind
    pat_ty

           -- Make the 'matcher'
           ; ((Id, Bool)
    matcher_id, LHsBinds GhcTc
    matcher_bind) <- Located Name
    -> LPat GhcTc
    -> ([Id], [Kind], TcEvBinds, [Id])
    -> ([Id], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> TcM ((Id, Bool), LHsBinds GhcTc)
    tcPatSynMatcher Located Name
    lname LPat GhcTc
    lpat'
                                             ([VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    univ_tvs, [Kind]
    req_theta, TcEvBinds
    req_ev_binds, [Id]
    req_dicts)
                                             ([VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    ex_tvs, [Kind]
    ex_tys, [Kind]
    prov_theta, [EvTerm]
    prov_dicts)
                                             ([LHsExpr GhcTc]
    args, [Kind]
    arg_tys)
                                             Kind
    pat_ty

           -- Make the 'builder'
           ; Maybe (Id, Bool)
    builder_id <- HsPatSynDir GhcRn
    -> Located Name
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [Kind]
    -> Kind
    -> TcM (Maybe (Id, Bool))
    forall a.
    HsPatSynDir a
    -> Located Name
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [Kind]
    -> Kind
    -> TcM (Maybe (Id, Bool))
    mkPatSynBuilderId HsPatSynDir GhcRn
    dir Located Name
    lname
                                             [VarBndr Id Specificity]
    univ_tvs [Kind]
    req_theta
                                             [VarBndr Id Specificity]
    ex_tvs   [Kind]
    prov_theta
                                             [Kind]
    arg_tys Kind
    pat_ty

             -- TODO: Make this have the proper information
           ; let mkFieldLabel :: Name -> FieldLabel
    mkFieldLabel Name
    name = FieldLabel :: forall a. FieldLabelString -> Bool -> a -> FieldLbl a
    FieldLabel { flLabel :: FieldLabelString
    flLabel = OccName -> FieldLabelString
    occNameFS (Name -> OccName
    nameOccName Name
    name)
                                                , flIsOverloaded :: Bool
    flIsOverloaded = Bool
    False
                                                , flSelector :: Name
    flSelector = Name
    name }
                 field_labels' :: [FieldLabel]
    field_labels' = (Name -> FieldLabel) -> [Name] -> [FieldLabel]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> FieldLabel
    mkFieldLabel [Name]
    field_labels

           -- Make the PatSyn itself
           ; let patSyn :: PatSyn
    patSyn = Name
    -> Bool
    -> ([VarBndr Id Specificity], [Kind])
    -> ([VarBndr Id Specificity], [Kind])
    -> [Kind]
    -> Kind
    -> (Id, Bool)
    -> Maybe (Id, Bool)
    -> [FieldLabel]
    -> PatSyn
    mkPatSyn (Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc Located Name
    lname) Bool
    is_infix
                            ([VarBndr Id Specificity]
    univ_tvs, [Kind]
    req_theta)
                            ([VarBndr Id Specificity]
    ex_tvs, [Kind]
    prov_theta)
                            [Kind]
    arg_tys
                            Kind
    pat_ty
                            (Id, Bool)
    matcher_id Maybe (Id, Bool)
    builder_id
                            [FieldLabel]
    field_labels'

           -- Selectors
           ; let rn_rec_sel_binds :: [(Id, LHsBind GhcRn)]
    rn_rec_sel_binds = PatSyn -> [FieldLabel] -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds PatSyn
    patSyn (PatSyn -> [FieldLabel]
    patSynFieldLabels PatSyn
    patSyn)
                 tything :: TyThing
    tything = ConLike -> TyThing
    AConLike (PatSyn -> ConLike
    PatSynCon PatSyn
    patSyn)
           ; TcGblEnv
    tcg_env <- [TyThing] -> TcM TcGblEnv -> TcM TcGblEnv
    forall r. [TyThing] -> TcM r -> TcM r
    tcExtendGlobalEnv [TyThing
    tything] (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                        [(Id, LHsBind GhcRn)] -> TcM TcGblEnv
    tcRecSelBinds [(Id, LHsBind GhcRn)]
    rn_rec_sel_binds

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tc_patsyn_finish }" MsgDoc
    empty
           ; (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcTc
    matcher_bind, TcGblEnv
    tcg_env) }

    {-
    ************************************************************************
    *                                                                      *
             Constructing the "matcher" Id and its binding
    *                                                                      *
    ************************************************************************
    -}

    tcPatSynMatcher :: Located Name
                    -> LPat GhcTc
                    -> ([TcTyVar], ThetaType, TcEvBinds, [EvVar])
                    -> ([TcTyVar], [TcType], ThetaType, [EvTerm])
                    -> ([LHsExpr GhcTc], [TcType])
                    -> TcType
                    -> TcM ((Id, Bool), LHsBinds GhcTc)
    -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
    tcPatSynMatcher :: Located Name
    -> LPat GhcTc
    -> ([Id], [Kind], TcEvBinds, [Id])
    -> ([Id], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> TcM ((Id, Bool), LHsBinds GhcTc)
    tcPatSynMatcher (L SrcSpan
    loc Name
    name) LPat GhcTc
    lpat
                    ([Id]
    univ_tvs, [Kind]
    req_theta, TcEvBinds
    req_ev_binds, [Id]
    req_dicts)
                    ([Id]
    ex_tvs, [Kind]
    ex_tys, [Kind]
    prov_theta, [EvTerm]
    prov_dicts)
                    ([LHsExpr GhcTc]
    args, [Kind]
    arg_tys) Kind
    pat_ty
      = do { Name
    rr_name <- OccName -> SrcSpan -> TcRnIf TcGblEnv TcLclEnv Name
    newNameAt (String -> OccName
    mkTyVarOcc String
    "rep") SrcSpan
    loc
           ; Name
    tv_name <- OccName -> SrcSpan -> TcRnIf TcGblEnv TcLclEnv Name
    newNameAt (String -> OccName
    mkTyVarOcc String
    "r")   SrcSpan
    loc
           ; let rr_tv :: Id
    rr_tv  = Name -> Kind -> Id
    mkTyVar Name
    rr_name Kind
    runtimeRepTy
                 rr :: Kind
    rr     = Id -> Kind
    mkTyVarTy Id
    rr_tv
                 res_tv :: Id
    res_tv = Name -> Kind -> Id
    mkTyVar Name
    tv_name (Kind -> Kind
    tYPE Kind
    rr)
                 res_ty :: Kind
    res_ty = Id -> Kind
    mkTyVarTy Id
    res_tv
                 is_unlifted :: Bool
    is_unlifted = [LHsExpr GhcTc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LHsExpr GhcTc]
    args Bool -> Bool -> Bool
    && [EvTerm] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvTerm]
    prov_dicts
                 ([LHsExpr GhcTc]
    cont_args, [Kind]
    cont_arg_tys)
                   | Bool
    is_unlifted = ([IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    voidPrimId], [Kind
    voidPrimTy])
                   | Bool
    otherwise   = ([LHsExpr GhcTc]
    args,                 [Kind]
    arg_tys)
                 cont_ty :: Kind
    cont_ty = [Id] -> [Kind] -> Kind -> Kind
    mkInfSigmaTy [Id]
    ex_tvs [Kind]
    prov_theta (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                           [Kind] -> Kind -> Kind
    mkVisFunTysMany [Kind]
    cont_arg_tys Kind
    res_ty

                 fail_ty :: Kind
    fail_ty  = Kind -> Kind -> Kind
    mkVisFunTyMany Kind
    voidPrimTy Kind
    res_ty

           ; Name
    matcher_name <- Name -> (OccName -> OccName) -> TcRnIf TcGblEnv TcLclEnv Name
    forall m n. Name -> (OccName -> OccName) -> TcRnIf m n Name
    newImplicitBinder Name
    name OccName -> OccName
    mkMatcherOcc
           ; Id
    scrutinee    <- FieldLabelString
    -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Id
    forall gbl lcl.
    FieldLabelString -> Kind -> Kind -> TcRnIf gbl lcl Id
    newSysLocalId (String -> FieldLabelString
    fsLit String
    "scrut") Kind
    Many Kind
    pat_ty
           ; Id
    cont         <- FieldLabelString
    -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Id
    forall gbl lcl.
    FieldLabelString -> Kind -> Kind -> TcRnIf gbl lcl Id
    newSysLocalId (String -> FieldLabelString
    fsLit String
    "cont")  Kind
    Many Kind
    cont_ty
           ; Id
    fail         <- FieldLabelString
    -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) Id
    forall gbl lcl.
    FieldLabelString -> Kind -> Kind -> TcRnIf gbl lcl Id
    newSysLocalId (String -> FieldLabelString
    fsLit String
    "fail")  Kind
    Many Kind
    fail_ty

           ; DynFlags
    dflags       <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; let matcher_tau :: Kind
    matcher_tau   = [Kind] -> Kind -> Kind
    mkVisFunTysMany [Kind
    pat_ty, Kind
    cont_ty, Kind
    fail_ty] Kind
    res_ty
                 matcher_sigma :: Kind
    matcher_sigma = [Id] -> [Kind] -> Kind -> Kind
    mkInfSigmaTy (Id
    rr_tvId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :Id
    res_tvId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    univ_tvs) [Kind]
    req_theta Kind
    matcher_tau
                 matcher_id :: Id
    matcher_id    = Name -> Kind -> Id
    mkExportedVanillaId Name
    matcher_name Kind
    matcher_sigma
                                 -- See Note [Exported LocalIds] in GHC.Types.Id

                 inst_wrap :: HsWrapper
    inst_wrap = [EvTerm] -> HsWrapper
    mkWpEvApps [EvTerm]
    prov_dicts HsWrapper -> HsWrapper -> HsWrapper
    <.> [Kind] -> HsWrapper
    mkWpTyApps [Kind]
    ex_tys
                 cont' :: LHsExpr GhcTc
    cont' = (LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc)
    -> LHsExpr GhcTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    inst_wrap (IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    cont)) [LHsExpr GhcTc]
    cont_args

                 fail' :: LHsExpr GhcTc
    fail' = IdP GhcTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
    nlHsApps Id
    IdP GhcTc
    fail [IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    voidPrimId]

                 args :: [Located (Pat GhcTc)]
    args = (Id -> Located (Pat GhcTc)) -> [Id] -> [Located (Pat GhcTc)]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Located (Pat GhcTc)
    forall (id :: Pass). IdP (GhcPass id) -> LPat (GhcPass id)
    nlVarPat [Id
    scrutinee, Id
    cont, Id
    fail]
                 lwpat :: Located (Pat GhcTc)
    lwpat = Pat GhcTc -> Located (Pat GhcTc)
    forall e. e -> Located e
    noLoc (Pat GhcTc -> Located (Pat GhcTc))
    -> Pat GhcTc -> Located (Pat GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XWildPat GhcTc -> Pat GhcTc
    forall p. XWildPat p -> Pat p
    WildPat Kind
    XWildPat GhcTc
    pat_ty
                 cases :: [LMatch GhcTc (LHsExpr GhcTc)]
    cases = if DynFlags -> LPat GhcTc -> Bool
    forall (p :: Pass).
    OutputableBndrId p =>
    DynFlags -> LPat (GhcPass p) -> Bool
    isIrrefutableHsPat DynFlags
    dflags LPat GhcTc
    lpat
                         then [LPat GhcTc -> LHsExpr GhcTc -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass) (body :: * -> *).
    LPat (GhcPass p)
    -> Located (body (GhcPass p))
    -> LMatch (GhcPass p) (Located (body (GhcPass p)))
    mkHsCaseAlt LPat GhcTc
    lpat  LHsExpr GhcTc
    cont']
                         else [LPat GhcTc -> LHsExpr GhcTc -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass) (body :: * -> *).
    LPat (GhcPass p)
    -> Located (body (GhcPass p))
    -> LMatch (GhcPass p) (Located (body (GhcPass p)))
    mkHsCaseAlt LPat GhcTc
    lpat  LHsExpr GhcTc
    cont',
                               LPat GhcTc -> LHsExpr GhcTc -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass) (body :: * -> *).
    LPat (GhcPass p)
    -> Located (body (GhcPass p))
    -> LMatch (GhcPass p) (Located (body (GhcPass p)))
    mkHsCaseAlt Located (Pat GhcTc)
    LPat GhcTc
    lwpat LHsExpr GhcTc
    fail']
                 body :: LHsExpr GhcTc
    body = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap (TcEvBinds -> HsWrapper
    mkWpLet TcEvBinds
    req_ev_binds) (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                        SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L (Located (Pat GhcTc) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located (Pat GhcTc)
    LPat GhcTc
    lpat) (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                        XCase GhcTc
    -> LHsExpr GhcTc
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> HsExpr GhcTc
    forall p.
    XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsCase NoExtField
    XCase GhcTc
    noExtField (IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    scrutinee) (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                        MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG{ mg_alts :: Located [LMatch GhcTc (LHsExpr GhcTc)]
    mg_alts = SrcSpan
    -> [LMatch GhcTc (LHsExpr GhcTc)]
    -> Located [LMatch GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L (Located (Pat GhcTc) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located (Pat GhcTc)
    LPat GhcTc
    lpat) [LMatch GhcTc (LHsExpr GhcTc)]
    cases
                          , mg_ext :: XMG GhcTc (LHsExpr GhcTc)
    mg_ext = [Scaled Kind] -> Kind -> MatchGroupTc
    MatchGroupTc [Kind -> Scaled Kind
    forall a. a -> Scaled a
    unrestricted Kind
    pat_ty] Kind
    res_ty
                          , mg_origin :: Origin
    mg_origin = Origin
    Generated
                          }
                 body' :: LHsExpr GhcTc
    body' = HsExpr GhcTc -> LHsExpr GhcTc
    forall e. e -> Located e
    noLoc (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                         XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam NoExtField
    XLam GhcTc
    noExtField (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                         MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG{ mg_alts :: Located [LMatch GhcTc (LHsExpr GhcTc)]
    mg_alts = [LMatch GhcTc (LHsExpr GhcTc)]
    -> Located [LMatch GhcTc (LHsExpr GhcTc)]
    forall e. e -> Located e
    noLoc [HsMatchContext (NoGhcTc GhcTc)
    -> [LPat GhcTc] -> LHsExpr GhcTc -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass) (body :: * -> *).
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> Located (body (GhcPass p))
    -> LMatch (GhcPass p) (Located (body (GhcPass p)))
    mkSimpleMatch HsMatchContext (NoGhcTc GhcTc)
    forall p. HsMatchContext p
    LambdaExpr
                                                            [Located (Pat GhcTc)]
    [LPat GhcTc]
    args LHsExpr GhcTc
    body]
                           , mg_ext :: XMG GhcTc (LHsExpr GhcTc)
    mg_ext = [Scaled Kind] -> Kind -> MatchGroupTc
    MatchGroupTc ((Kind -> Scaled Kind) -> [Kind] -> [Scaled Kind]
    forall a b. (a -> b) -> [a] -> [b]
    map Kind -> Scaled Kind
    forall a. a -> Scaled a
    unrestricted [Kind
    pat_ty, Kind
    cont_ty, Kind
    fail_ty]) Kind
    res_ty
                           , mg_origin :: Origin
    mg_origin = Origin
    Generated
                           }
                 match :: LMatch GhcTc (LHsExpr GhcTc)
    match = HsMatchContext (NoGhcTc GhcTc)
    -> [LPat GhcTc]
    -> LHsExpr GhcTc
    -> Located (HsLocalBinds GhcTc)
    -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass).
    IsPass p =>
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> LHsExpr (GhcPass p)
    -> Located (HsLocalBinds (GhcPass p))
    -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
    mkMatch (GenLocated SrcSpan (IdP GhcRn) -> HsMatchContext GhcRn
    forall p. LIdP p -> HsMatchContext p
    mkPrefixFunRhs (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    name)) []
                                 ([Id] -> [Id] -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkHsLams (Id
    rr_tvId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :Id
    res_tvId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    univ_tvs)
                                           [Id]
    req_dicts LHsExpr GhcTc
    body')
                                 (HsLocalBinds GhcTc -> Located (HsLocalBinds GhcTc)
    forall e. e -> Located e
    noLoc (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds NoExtField
    XEmptyLocalBinds GhcTc GhcTc
    noExtField))
                 mg :: MatchGroup GhcTc (LHsExpr GhcTc)
                 mg :: MatchGroup GhcTc (LHsExpr GhcTc)
    mg = MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG{ mg_alts :: Located [LMatch GhcTc (LHsExpr GhcTc)]
    mg_alts = SrcSpan
    -> [LMatch GhcTc (LHsExpr GhcTc)]
    -> Located [LMatch GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L (LMatch GhcTc (LHsExpr GhcTc) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LMatch GhcTc (LHsExpr GhcTc)
    match) [LMatch GhcTc (LHsExpr GhcTc)
    match]
                        , mg_ext :: XMG GhcTc (LHsExpr GhcTc)
    mg_ext = [Scaled Kind] -> Kind -> MatchGroupTc
    MatchGroupTc [] Kind
    res_ty
                        , mg_origin :: Origin
    mg_origin = Origin
    Generated
                        }

           ; let bind :: HsBindLR GhcTc GhcTc
    bind = FunBind :: forall idL idR.
    XFunBind idL idR
    -> Located (IdP idL)
    -> MatchGroup idR (LHsExpr idR)
    -> [Tickish Id]
    -> HsBindLR idL idR
    FunBind{ fun_id :: Located (IdP GhcTc)
    fun_id = SrcSpan -> Id -> Located Id
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Id
    matcher_id
                               , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
    fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
    mg
                               , fun_ext :: XFunBind GhcTc GhcTc
    fun_ext = XFunBind GhcTc GhcTc
    HsWrapper
    idHsWrapper
                               , fun_tick :: [Tickish Id]
    fun_tick = [] }
                 matcher_bind :: LHsBinds GhcTc
    matcher_bind = GenLocated SrcSpan (HsBindLR GhcTc GhcTc) -> LHsBinds GhcTc
    forall a. a -> Bag a
    unitBag (HsBindLR GhcTc GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall e. e -> Located e
    noLoc HsBindLR GhcTc GhcTc
    bind)

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcPatSynMatcher" (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    name MsgDoc -> MsgDoc -> MsgDoc
    $$ Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Id -> Kind
    idType Id
    matcher_id))
           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcPatSynMatcher" (LHsBinds GhcTc -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr LHsBinds GhcTc
    matcher_bind)

           ; ((Id, Bool), LHsBinds GhcTc) -> TcM ((Id, Bool), LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Id
    matcher_id, Bool
    is_unlifted), LHsBinds GhcTc
    matcher_bind) }

    mkPatSynRecSelBinds :: PatSyn
                        -> [FieldLabel]  -- ^ Visible field labels
                        -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds :: PatSyn -> [FieldLabel] -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds PatSyn
    ps [FieldLabel]
    fields
      = [ [ConLike] -> RecSelParent -> FieldLabel -> (Id, LHsBind GhcRn)
    mkOneRecordSelector [PatSyn -> ConLike
    PatSynCon PatSyn
    ps] (PatSyn -> RecSelParent
    RecSelPatSyn PatSyn
    ps) FieldLabel
    fld_lbl
        | FieldLabel
    fld_lbl <- [FieldLabel]
    fields ]

    isUnidirectional :: HsPatSynDir a -> Bool
    isUnidirectional :: forall a. HsPatSynDir a -> Bool
    isUnidirectional HsPatSynDir a
    Unidirectional          = Bool
    True
    isUnidirectional HsPatSynDir a
    ImplicitBidirectional   = Bool
    False
    isUnidirectional ExplicitBidirectional{} = Bool
    False

    {-
    ************************************************************************
    *                                                                      *
             Constructing the "builder" Id
    *                                                                      *
    ************************************************************************
    -}

    mkPatSynBuilderId :: HsPatSynDir a -> Located Name
                      -> [InvisTVBinder] -> ThetaType
                      -> [InvisTVBinder] -> ThetaType
                      -> [Type] -> Type
                      -> TcM (Maybe (Id, Bool))
    mkPatSynBuilderId :: forall a.
    HsPatSynDir a
    -> Located Name
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [Kind]
    -> Kind
    -> TcM (Maybe (Id, Bool))
    mkPatSynBuilderId HsPatSynDir a
    dir (L SrcSpan
    _ Name
    name)
                      [VarBndr Id Specificity]
    univ_bndrs [Kind]
    req_theta [VarBndr Id Specificity]
    ex_bndrs [Kind]
    prov_theta
                      [Kind]
    arg_tys Kind
    pat_ty
      | HsPatSynDir a -> Bool
    forall a. HsPatSynDir a -> Bool
    isUnidirectional HsPatSynDir a
    dir
      = Maybe (Id, Bool) -> TcM (Maybe (Id, Bool))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Id, Bool)
    forall a. Maybe a
    Nothing
      | Bool
    otherwise
      = do { Name
    builder_name <- Name -> (OccName -> OccName) -> TcRnIf TcGblEnv TcLclEnv Name
    forall m n. Name -> (OccName -> OccName) -> TcRnIf m n Name
    newImplicitBinder Name
    name OccName -> OccName
    mkBuilderOcc
           ; let theta :: [Kind]
    theta          = [Kind]
    req_theta [Kind] -> [Kind] -> [Kind]
    forall a. [a] -> [a] -> [a]
    ++ [Kind]
    prov_theta
                 need_dummy_arg :: Bool
    need_dummy_arg = HasDebugCallStack => Kind -> Bool
    Kind -> Bool
    isUnliftedType Kind
    pat_ty Bool -> Bool -> Bool
    && [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Kind]
    arg_tys Bool -> Bool -> Bool
    && [Kind] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Kind]
    theta
                 builder_sigma :: Kind
    builder_sigma  = Bool -> Kind -> Kind
    add_void Bool
    need_dummy_arg (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                                  [VarBndr Id Specificity] -> Kind -> Kind
    mkInvisForAllTys [VarBndr Id Specificity]
    univ_bndrs (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                                  [VarBndr Id Specificity] -> Kind -> Kind
    mkInvisForAllTys [VarBndr Id Specificity]
    ex_bndrs (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                                  [Kind] -> Kind -> Kind
    mkPhiTy [Kind]
    theta (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                                  [Kind] -> Kind -> Kind
    mkVisFunTysMany [Kind]
    arg_tys (Kind -> Kind) -> Kind -> Kind
    forall a b. (a -> b) -> a -> b
    $
                                  Kind
    pat_ty
                 builder_id :: Id
    builder_id     = Name -> Kind -> Id
    mkExportedVanillaId Name
    builder_name Kind
    builder_sigma
                  -- See Note [Exported LocalIds] in GHC.Types.Id

                 builder_id' :: Id
    builder_id'    = HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
    (IdInfo -> IdInfo) -> Id -> Id
    modifyIdInfo (IdInfo -> Kind -> IdInfo
    `setLevityInfoWithType` Kind
    pat_ty) Id
    builder_id

           ; Maybe (Id, Bool) -> TcM (Maybe (Id, Bool))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Id, Bool) -> Maybe (Id, Bool)
    forall a. a -> Maybe a
    Just (Id
    builder_id', Bool
    need_dummy_arg)) }
      where

    tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn
                        -> TcM (LHsBinds GhcTc)
    -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
    tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc)
    tcPatSynBuilderBind (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
    psb_id = L SrcSpan
    loc IdP GhcRn
    name
                             , psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
    psb_def = LPat GhcRn
    lpat
                             , psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
    psb_dir = HsPatSynDir GhcRn
    dir
                             , psb_args :: forall idL idR.
    PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
    psb_args = HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details })
      | HsPatSynDir GhcRn -> Bool
    forall a. HsPatSynDir a -> Bool
    isUnidirectional HsPatSynDir GhcRn
    dir
      = LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsBinds GhcTc
    forall a. Bag a
    emptyBag

      | Left MsgDoc
    why <- Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    mb_match_group       -- Can't invert the pattern
      = SrcSpan -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (Located (Pat GhcRn) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located (Pat GhcRn)
    LPat GhcRn
    lpat) (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $ MsgDoc -> TcM (LHsBinds GhcTc)
    forall a. MsgDoc -> TcM a
    failWithTc (MsgDoc -> TcM (LHsBinds GhcTc)) -> MsgDoc -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        [MsgDoc] -> MsgDoc
    vcat [ MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Invalid right-hand side of bidirectional pattern synonym"
                     MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    name) MsgDoc -> MsgDoc -> MsgDoc
    <> MsgDoc
    colon)
                  Int
    2 MsgDoc
    why
             , String -> MsgDoc
    text String
    "RHS pattern:" MsgDoc -> MsgDoc -> MsgDoc
    <+> Located (Pat GhcRn) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Located (Pat GhcRn)
    LPat GhcRn
    lpat ]

      | Right MatchGroup GhcRn (LHsExpr GhcRn)
    match_group <- Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    mb_match_group  -- Bidirectional
      = do { PatSyn
    patsyn <- Name -> TcM PatSyn
    tcLookupPatSyn Name
    IdP GhcRn
    name
           ; case PatSyn -> Maybe (Id, Bool)
    patSynBuilder PatSyn
    patsyn of {
               Maybe (Id, Bool)
    Nothing -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsBinds GhcTc
    forall a. Bag a
    emptyBag ;
                 -- This case happens if we found a type error in the
                 -- pattern synonym, recovered, and put a placeholder
                 -- with patSynBuilder=Nothing in the environment

               Just (Id
    builder_id, Bool
    need_dummy_arg) ->  -- Normal case
        do { -- Bidirectional, so patSynBuilder returns Just
             let match_group' :: MatchGroup GhcRn (LHsExpr GhcRn)
    match_group' | Bool
    need_dummy_arg = MatchGroup GhcRn (LHsExpr GhcRn)
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    add_dummy_arg MatchGroup GhcRn (LHsExpr GhcRn)
    match_group
                              | Bool
    otherwise      = MatchGroup GhcRn (LHsExpr GhcRn)
    match_group

                 bind :: HsBindLR GhcRn GhcRn
    bind = FunBind :: forall idL idR.
    XFunBind idL idR
    -> Located (IdP idL)
    -> MatchGroup idR (LHsExpr idR)
    -> [Tickish Id]
    -> HsBindLR idL idR
    FunBind { fun_id :: GenLocated SrcSpan (IdP GhcRn)
    fun_id      = SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (Id -> Name
    idName Id
    builder_id)
                                , fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
    fun_matches = MatchGroup GhcRn (LHsExpr GhcRn)
    match_group'
                                , fun_ext :: XFunBind GhcRn GhcRn
    fun_ext     = NameSet
    XFunBind GhcRn GhcRn
    emptyNameSet
                                , fun_tick :: [Tickish Id]
    fun_tick    = [] }

                 sig :: TcIdSigInfo
    sig = UserTypeCtxt -> Id -> TcIdSigInfo
    completeSigFromId (Name -> UserTypeCtxt
    PatSynCtxt Name
    IdP GhcRn
    name) Id
    builder_id

           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcPatSynBuilderBind {" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             PatSyn -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr PatSyn
    patsyn MsgDoc -> MsgDoc -> MsgDoc
    $$ Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Id
    builder_id MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    dcolon MsgDoc -> MsgDoc -> MsgDoc
    <+> Kind -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr (Id -> Kind
    idType Id
    builder_id)
           ; (LHsBinds GhcTc
    builder_binds, [Id]
    _) <- TcPragEnv
    -> TcIdSigInfo -> LHsBind GhcRn -> TcM (LHsBinds GhcTc, [Id])
    tcPolyCheck TcPragEnv
    emptyPragEnv TcIdSigInfo
    sig (HsBindLR GhcRn GhcRn -> LHsBind GhcRn
    forall e. e -> Located e
    noLoc HsBindLR GhcRn GhcRn
    bind)
           ; String -> MsgDoc -> TcRn ()
    traceTc String
    "tcPatSynBuilderBind }" (MsgDoc -> TcRn ()) -> MsgDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ LHsBinds GhcTc -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr LHsBinds GhcTc
    builder_binds
           ; LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsBinds GhcTc
    builder_binds } } }

    #if __GLASGOW_HASKELL__ <= 810
      | otherwise = panic "tcPatSynBuilderBind"  -- Both cases dealt with
    #endif
      where
        mb_match_group :: Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    mb_match_group
           = case HsPatSynDir GhcRn
    dir of
               ExplicitBidirectional MatchGroup GhcRn (LHsExpr GhcRn)
    explicit_mg -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    forall a b. b -> Either a b
    Right MatchGroup GhcRn (LHsExpr GhcRn)
    explicit_mg
               HsPatSynDir GhcRn
    ImplicitBidirectional -> (LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn))
    -> Either MsgDoc (LHsExpr GhcRn)
    -> Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
    mk_mg (Name
    -> [Located Name] -> LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    tcPatToExpr Name
    IdP GhcRn
    name [Located Name]
    [GenLocated SrcSpan (IdP GhcRn)]
    args LPat GhcRn
    lpat)
               HsPatSynDir GhcRn
    Unidirectional -> String -> Either MsgDoc (MatchGroup GhcRn (LHsExpr GhcRn))
    forall a. String -> a
    panic String
    "tcPatSynBuilderBind"

        mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
        mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
    mk_mg LHsExpr GhcRn
    body = Origin
    -> [LMatch GhcRn (LHsExpr GhcRn)]
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    forall name (body :: * -> *).
    (XMG name (Located (body name)) ~ NoExtField) =>
    Origin
    -> [LMatch name (Located (body name))]
    -> MatchGroup name (Located (body name))
    mkMatchGroup Origin
    Generated [LMatch GhcRn (LHsExpr GhcRn)
    builder_match]
              where
                builder_args :: [Located (Pat GhcRn)]
    builder_args  = [SrcSpan -> Pat GhcRn -> Located (Pat GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XVarPat GhcRn -> GenLocated SrcSpan (IdP GhcRn) -> Pat GhcRn
    forall p. XVarPat p -> Located (IdP p) -> Pat p
    VarPat NoExtField
    XVarPat GhcRn
    noExtField (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    n))
                                | L SrcSpan
    loc Name
    n <- [Located Name]
    [GenLocated SrcSpan (IdP GhcRn)]
    args]
                builder_match :: LMatch GhcRn (LHsExpr GhcRn)
    builder_match = HsMatchContext (NoGhcTc GhcRn)
    -> [LPat GhcRn]
    -> LHsExpr GhcRn
    -> Located (HsLocalBinds GhcRn)
    -> LMatch GhcRn (LHsExpr GhcRn)
    forall (p :: Pass).
    IsPass p =>
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> LHsExpr (GhcPass p)
    -> Located (HsLocalBinds (GhcPass p))
    -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
    mkMatch (GenLocated SrcSpan (IdP GhcRn) -> HsMatchContext GhcRn
    forall p. LIdP p -> HsMatchContext p
    mkPrefixFunRhs (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    IdP GhcRn
    name))
                                        [Located (Pat GhcRn)]
    [LPat GhcRn]
    builder_args LHsExpr GhcRn
    body
                                        (HsLocalBinds GhcRn -> Located (HsLocalBinds GhcRn)
    forall e. e -> Located e
    noLoc (XEmptyLocalBinds GhcRn GhcRn -> HsLocalBinds GhcRn
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds NoExtField
    XEmptyLocalBinds GhcRn GhcRn
    noExtField))

        args :: [GenLocated SrcSpan (IdP GhcRn)]
    args = case HsPatSynDetails (GenLocated SrcSpan (IdP GhcRn))
    details of
                  PrefixCon [GenLocated SrcSpan (IdP GhcRn)]
    args     -> [GenLocated SrcSpan (IdP GhcRn)]
    args
                  InfixCon GenLocated SrcSpan (IdP GhcRn)
    arg1 GenLocated SrcSpan (IdP GhcRn)
    arg2 -> [GenLocated SrcSpan (IdP GhcRn)
    arg1, GenLocated SrcSpan (IdP GhcRn)
    arg2]
                  RecCon [RecordPatSynField (GenLocated SrcSpan (IdP GhcRn))]
    args        -> (RecordPatSynField (Located Name) -> Located Name)
    -> [RecordPatSynField (Located Name)] -> [Located Name]
    forall a b. (a -> b) -> [a] -> [b]
    map RecordPatSynField (Located Name) -> Located Name
    forall a. RecordPatSynField a -> a
    recordPatSynPatVar [RecordPatSynField (Located Name)]
    [RecordPatSynField (GenLocated SrcSpan (IdP GhcRn))]
    args

        add_dummy_arg :: MatchGroup GhcRn (LHsExpr GhcRn)
                      -> MatchGroup GhcRn (LHsExpr GhcRn)
        add_dummy_arg :: MatchGroup GhcRn (LHsExpr GhcRn)
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    add_dummy_arg mg :: MatchGroup GhcRn (LHsExpr GhcRn)
    mg@(MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts =
                               (L SrcSpan
    l [L SrcSpan
    loc match :: Match GhcRn (LHsExpr GhcRn)
    match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcRn]
    pats })]) })
          = MatchGroup GhcRn (LHsExpr GhcRn)
    mg { mg_alts :: GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
    mg_alts = SrcSpan
    -> [LMatch GhcRn (LHsExpr GhcRn)]
    -> GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [SrcSpan
    -> Match GhcRn (LHsExpr GhcRn) -> LMatch GhcRn (LHsExpr GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (Match GhcRn (LHsExpr GhcRn)
    match { m_pats :: [LPat GhcRn]
    m_pats = Located (Pat GhcRn)
    LPat GhcRn
    nlWildPatName Located (Pat GhcRn)
    -> [Located (Pat GhcRn)] -> [Located (Pat GhcRn)]
    forall a. a -> [a] -> [a]
    : [Located (Pat GhcRn)]
    [LPat GhcRn]
    pats })] }
        add_dummy_arg MatchGroup GhcRn (LHsExpr GhcRn)
    other_mg = String -> MsgDoc -> MatchGroup GhcRn (LHsExpr GhcRn)
    forall a. HasCallStack => String -> MsgDoc -> a
    pprPanic String
    "add_dummy_arg" (MsgDoc -> MatchGroup GhcRn (LHsExpr GhcRn))
    -> MsgDoc -> MatchGroup GhcRn (LHsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $
                                 MatchGroup GhcRn (LHsExpr GhcRn) -> MsgDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    MatchGroup (GhcPass idR) body -> MsgDoc
    pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
    other_mg

    tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTc, TcSigmaType)
    -- monadic only for failure
    tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTc, Kind)
    tcPatSynBuilderOcc PatSyn
    ps
      | Just (Id
    builder_id, Bool
    add_void_arg) <- Maybe (Id, Bool)
    builder
      , let builder_expr :: HsExpr GhcTc
    builder_expr = XConLikeOut GhcTc -> ConLike -> HsExpr GhcTc
    forall p. XConLikeOut p -> ConLike -> HsExpr p
    HsConLikeOut NoExtField
    XConLikeOut GhcTc
    noExtField (PatSyn -> ConLike
    PatSynCon PatSyn
    ps)
            builder_ty :: Kind
    builder_ty   = Id -> Kind
    idType Id
    builder_id
      = (HsExpr GhcTc, Kind) -> TcM (HsExpr GhcTc, Kind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((HsExpr GhcTc, Kind) -> TcM (HsExpr GhcTc, Kind))
    -> (HsExpr GhcTc, Kind) -> TcM (HsExpr GhcTc, Kind)
    forall a b. (a -> b) -> a -> b
    $
        if Bool
    add_void_arg
        then ( HsExpr GhcTc
    builder_expr   -- still just return builder_expr; the void# arg is added
                              -- by dsConLike in the desugarer
             , Kind -> Kind
    tcFunResultTy Kind
    builder_ty )
        else (HsExpr GhcTc
    builder_expr, Kind
    builder_ty)

      | Bool
    otherwise  -- Unidirectional
      = Name -> TcM (HsExpr GhcTc, Kind)
    forall name a. Outputable name => name -> TcM a
    nonBidirectionalErr Name
    name
      where
        name :: Name
    name    = PatSyn -> Name
    patSynName PatSyn
    ps
        builder :: Maybe (Id, Bool)
    builder = PatSyn -> Maybe (Id, Bool)
    patSynBuilder PatSyn
    ps

    add_void :: Bool -> Type -> Type
    add_void :: Bool -> Kind -> Kind
    add_void Bool
    need_dummy_arg Kind
    ty
      | Bool
    need_dummy_arg = Kind -> Kind -> Kind
    mkVisFunTyMany Kind
    voidPrimTy Kind
    ty
      | Bool
    otherwise      = Kind
    ty

    tcPatToExpr :: Name -> [Located Name] -> LPat GhcRn
                -> Either MsgDoc (LHsExpr GhcRn)
    -- Given a /pattern/, return an /expression/ that builds a value
    -- that matches the pattern.  E.g. if the pattern is (Just [x]),
    -- the expression is (Just [x]).  They look the same, but the
    -- input uses constructors from HsPat and the output uses constructors
    -- from HsExpr.
    --
    -- Returns (Left r) if the pattern is not invertible, for reason r.
    -- See Note [Builder for a bidirectional pattern synonym]
    tcPatToExpr :: Name
    -> [Located Name] -> LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    tcPatToExpr Name
    name [Located Name]
    args LPat GhcRn
    pat = LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go LPat GhcRn
    pat
      where
        lhsVars :: NameSet
    lhsVars = [Name] -> NameSet
    mkNameSet ((Located Name -> Name) -> [Located Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [Located Name]
    args)

        -- Make a prefix con for prefix and infix patterns for simplicity
        mkPrefixConExpr :: Located Name -> [LPat GhcRn]
                        -> Either MsgDoc (HsExpr GhcRn)
        mkPrefixConExpr :: Located Name -> [LPat GhcRn] -> Either MsgDoc (HsExpr GhcRn)
    mkPrefixConExpr lcon :: Located Name
    lcon@(L SrcSpan
    loc Name
    _) [LPat GhcRn]
    pats
          = do { [LHsExpr GhcRn]
    exprs <- (Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn))
    -> [Located (Pat GhcRn)] -> Either MsgDoc [LHsExpr GhcRn]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn)
    LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go [Located (Pat GhcRn)]
    [LPat GhcRn]
    pats
               ; HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn)
    -> HsExpr GhcRn -> [LHsExpr GhcRn] -> HsExpr GhcRn
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\HsExpr GhcRn
    x LHsExpr GhcRn
    y -> XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp NoExtField
    XApp GhcRn
    noExtField (SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcRn
    x) LHsExpr GhcRn
    y)
                                (XVar GhcRn -> GenLocated SrcSpan (IdP GhcRn) -> HsExpr GhcRn
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcRn
    noExtField Located Name
    GenLocated SrcSpan (IdP GhcRn)
    lcon) [LHsExpr GhcRn]
    exprs) }

        mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn)
                        -> Either MsgDoc (HsExpr GhcRn)
        mkRecordConExpr :: Located Name
    -> HsRecFields GhcRn (LPat GhcRn) -> Either MsgDoc (HsExpr GhcRn)
    mkRecordConExpr Located Name
    con HsRecFields GhcRn (LPat GhcRn)
    fields
          = do { HsRecFields GhcRn (LHsExpr GhcRn)
    exprFields <- (Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn))
    -> HsRecFields GhcRn (Located (Pat GhcRn))
    -> Either MsgDoc (HsRecFields GhcRn (LHsExpr GhcRn))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn)
    LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go HsRecFields GhcRn (Located (Pat GhcRn))
    HsRecFields GhcRn (LPat GhcRn)
    fields
               ; HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XRecordCon GhcRn
    -> GenLocated SrcSpan (IdP GhcRn)
    -> HsRecFields GhcRn (LHsExpr GhcRn)
    -> HsExpr GhcRn
    forall p.
    XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
    RecordCon NoExtField
    XRecordCon GhcRn
    noExtField Located Name
    GenLocated SrcSpan (IdP GhcRn)
    con HsRecFields GhcRn (LHsExpr GhcRn)
    exprFields) }

        go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
        go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go (L SrcSpan
    loc Pat GhcRn
    p) = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsExpr GhcRn -> LHsExpr GhcRn)
    -> Either MsgDoc (HsExpr GhcRn) -> Either MsgDoc (LHsExpr GhcRn)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    go1 Pat GhcRn
    p

        go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
        go1 :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    go1 (ConPat NoExtField
    XConPat GhcRn
    NoExtField Located (ConLikeP GhcRn)
    con HsConPatDetails GhcRn
    info)
          = case HsConPatDetails GhcRn
    info of
              PrefixCon [LPat GhcRn]
    ps  -> Located Name -> [LPat GhcRn] -> Either MsgDoc (HsExpr GhcRn)
    mkPrefixConExpr Located Name
    Located (ConLikeP GhcRn)
    con [LPat GhcRn]
    ps
              InfixCon LPat GhcRn
    l LPat GhcRn
    r  -> Located Name -> [LPat GhcRn] -> Either MsgDoc (HsExpr GhcRn)
    mkPrefixConExpr Located Name
    Located (ConLikeP GhcRn)
    con [LPat GhcRn
    l,LPat GhcRn
    r]
              RecCon HsRecFields GhcRn (LPat GhcRn)
    fields -> Located Name
    -> HsRecFields GhcRn (LPat GhcRn) -> Either MsgDoc (HsExpr GhcRn)
    mkRecordConExpr Located Name
    Located (ConLikeP GhcRn)
    con HsRecFields GhcRn (LPat GhcRn)
    fields

        go1 (SigPat XSigPat GhcRn
    _ LPat GhcRn
    pat HsPatSigType (NoGhcTc GhcRn)
    _) = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    go1 (Located (Pat GhcRn) -> Pat GhcRn
    forall l e. GenLocated l e -> e
    unLoc Located (Pat GhcRn)
    LPat GhcRn
    pat)
            -- See Note [Type signatures and the builder expression]

        go1 (VarPat XVarPat GhcRn
    _ (L SrcSpan
    l IdP GhcRn
    var))
            | Name
    IdP GhcRn
    var Name -> NameSet -> Bool
    `elemNameSet` NameSet
    lhsVars
            = HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XVar GhcRn -> GenLocated SrcSpan (IdP GhcRn) -> HsExpr GhcRn
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcRn
    noExtField (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l Name
    IdP GhcRn
    var)
            | Bool
    otherwise
            = MsgDoc -> Either MsgDoc (HsExpr GhcRn)
    forall a b. a -> Either a b
    Left (MsgDoc -> MsgDoc
    quotes (Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    IdP GhcRn
    var) MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "is not bound by the LHS of the pattern synonym")
        go1 (ParPat XParPat GhcRn
    _ LPat GhcRn
    pat)          = (LHsExpr GhcRn -> HsExpr GhcRn)
    -> Either MsgDoc (LHsExpr GhcRn) -> Either MsgDoc (HsExpr GhcRn)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (XPar GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p. XPar p -> LHsExpr p -> HsExpr p
    HsPar NoExtField
    XPar GhcRn
    noExtField) (Either MsgDoc (LHsExpr GhcRn) -> Either MsgDoc (HsExpr GhcRn))
    -> Either MsgDoc (LHsExpr GhcRn) -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go LPat GhcRn
    pat
        go1 p :: Pat GhcRn
    p@(ListPat XListPat GhcRn
    reb [LPat GhcRn]
    pats)
          | Maybe SyntaxExprRn
    XListPat GhcRn
    Nothing <- XListPat GhcRn
    reb = do { [LHsExpr GhcRn]
    exprs <- (Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn))
    -> [Located (Pat GhcRn)] -> Either MsgDoc [LHsExpr GhcRn]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn)
    LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go [Located (Pat GhcRn)]
    [LPat GhcRn]
    pats
                                ; HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XExplicitList GhcRn
    -> Maybe (SyntaxExpr GhcRn) -> [LHsExpr GhcRn] -> HsExpr GhcRn
    forall p.
    XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
    ExplicitList NoExtField
    XExplicitList GhcRn
    noExtField Maybe (SyntaxExpr GhcRn)
    forall a. Maybe a
    Nothing [LHsExpr GhcRn]
    exprs }
          | Bool
    otherwise                   = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertibleListPat Pat GhcRn
    p
        go1 (TuplePat XTuplePat GhcRn
    _ [LPat GhcRn]
    pats Boxity
    box)       = do { [LHsExpr GhcRn]
    exprs <- (Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn))
    -> [Located (Pat GhcRn)] -> Either MsgDoc [LHsExpr GhcRn]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Located (Pat GhcRn) -> Either MsgDoc (LHsExpr GhcRn)
    LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
    go [Located (Pat GhcRn)]
    [LPat GhcRn]
    pats
                                             ; HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XExplicitTuple GhcRn -> [LHsTupArg GhcRn] -> Boxity -> HsExpr GhcRn
    forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
    ExplicitTuple NoExtField
    XExplicitTuple GhcRn
    noExtField
                                               ((LHsExpr GhcRn -> LHsTupArg GhcRn)
    -> [LHsExpr GhcRn] -> [LHsTupArg GhcRn]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsTupArg GhcRn -> LHsTupArg GhcRn
    forall e. e -> Located e
    noLoc (HsTupArg GhcRn -> LHsTupArg GhcRn)
    -> (LHsExpr GhcRn -> HsTupArg GhcRn)
    -> LHsExpr GhcRn
    -> LHsTupArg GhcRn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XPresent GhcRn -> LHsExpr GhcRn -> HsTupArg GhcRn
    forall id. XPresent id -> LHsExpr id -> HsTupArg id
    Present NoExtField
    XPresent GhcRn
    noExtField)) [LHsExpr GhcRn]
    exprs)
                                                                               Boxity
    box }
        go1 (SumPat XSumPat GhcRn
    _ LPat GhcRn
    pat Int
    alt Int
    arity)    = do { HsExpr GhcRn
    expr <- Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    go1 (Located (Pat GhcRn) -> Pat GhcRn
    forall l e. GenLocated l e -> e
    unLoc Located (Pat GhcRn)
    LPat GhcRn
    pat)
                                             ; HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XExplicitSum GhcRn -> Int -> Int -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
    ExplicitSum NoExtField
    XExplicitSum GhcRn
    noExtField Int
    alt Int
    arity
                                                                       (HsExpr GhcRn -> LHsExpr GhcRn
    forall e. e -> Located e
    noLoc HsExpr GhcRn
    expr)
                                             }
        go1 (LitPat XLitPat GhcRn
    _ HsLit GhcRn
    lit)              = HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
    forall p. XLitE p -> HsLit p -> HsExpr p
    HsLit NoExtField
    XLitE GhcRn
    noExtField HsLit GhcRn
    lit
        go1 (NPat XNPat GhcRn
    _ (L SrcSpan
    _ HsOverLit GhcRn
    n) Maybe (SyntaxExpr GhcRn)
    mb_neg SyntaxExpr GhcRn
    _)
            | Just (SyntaxExprRn HsExpr GhcRn
    neg) <- Maybe (SyntaxExpr GhcRn)
    mb_neg
                                        = HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcRn -> HsExpr GhcRn) -> LHsExpr GhcRn -> HsExpr GhcRn
    forall a b. (a -> b) -> a -> b
    $ (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn)
    -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (HsExpr GhcRn -> LHsExpr GhcRn
    forall e. e -> Located e
    noLoc HsExpr GhcRn
    neg)
                                                           [HsExpr GhcRn -> LHsExpr GhcRn
    forall e. e -> Located e
    noLoc (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit NoExtField
    XOverLitE GhcRn
    noExtField HsOverLit GhcRn
    n)]
            | Bool
    otherwise                 = HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either MsgDoc (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit NoExtField
    XOverLitE GhcRn
    noExtField HsOverLit GhcRn
    n
        go1 (SplicePat XSplicePat GhcRn
    _ (HsSpliced XSpliced GhcRn
    _ ThModFinalizers
    _ (HsSplicedPat Pat GhcRn
    pat)))
                                        = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    go1 Pat GhcRn
    pat
        go1 (SplicePat XSplicePat GhcRn
    _ (HsSpliced{})) = String -> Either MsgDoc (HsExpr GhcRn)
    forall a. String -> a
    panic String
    "Invalid splice variety"

        -- The following patterns are not invertible.
        go1 p :: Pat GhcRn
    p@(BangPat {})                       = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p -- #14112
        go1 p :: Pat GhcRn
    p@(LazyPat {})                       = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(WildPat {})                       = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(AsPat {})                         = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(ViewPat {})                       = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(NPlusKPat {})                     = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(SplicePat XSplicePat GhcRn
    _ (HsTypedSplice {}))   = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(SplicePat XSplicePat GhcRn
    _ (HsUntypedSplice {})) = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(SplicePat XSplicePat GhcRn
    _ (HsQuasiQuote {}))    = Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p

        notInvertible :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertible Pat GhcRn
    p = MsgDoc -> Either MsgDoc (HsExpr GhcRn)
    forall a b. a -> Either a b
    Left (Pat GhcRn -> MsgDoc
    not_invertible_msg Pat GhcRn
    p)

        not_invertible_msg :: Pat GhcRn -> MsgDoc
    not_invertible_msg Pat GhcRn
    p
          =   String -> MsgDoc
    text String
    "Pattern" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (Pat GhcRn -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Pat GhcRn
    p) MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "is not invertible"
          MsgDoc -> MsgDoc -> MsgDoc
    $+$ MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Suggestion: instead use an explicitly bidirectional"
                    MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "pattern synonym, e.g.")
                 Int
    2 (MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "pattern" MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    pp_name MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    pp_args MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    larrow
                          MsgDoc -> MsgDoc -> MsgDoc
    <+> Located (Pat GhcRn) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Located (Pat GhcRn)
    LPat GhcRn
    pat MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "where")
                       Int
    2 (MsgDoc
    pp_name MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    pp_args MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc
    equals MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "..."))
          where
            pp_name :: MsgDoc
    pp_name = Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Name
    name
            pp_args :: MsgDoc
    pp_args = [MsgDoc] -> MsgDoc
    hsep ((Located Name -> MsgDoc) -> [Located Name] -> [MsgDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Located Name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr [Located Name]
    args)

        -- We should really be able to invert list patterns, even when
        -- rebindable syntax is on, but doing so involves a bit of
        -- refactoring; see #14380.  Until then we reject with a
        -- helpful error message.
        notInvertibleListPat :: Pat GhcRn -> Either MsgDoc (HsExpr GhcRn)
    notInvertibleListPat Pat GhcRn
    p
          = MsgDoc -> Either MsgDoc (HsExpr GhcRn)
    forall a b. a -> Either a b
    Left ([MsgDoc] -> MsgDoc
    vcat [ Pat GhcRn -> MsgDoc
    not_invertible_msg Pat GhcRn
    p
                       , String -> MsgDoc
    text String
    "Reason: rebindable syntax is on."
                       , String -> MsgDoc
    text String
    "This is fixable: add use-case to #14380" ])

    {- Note [Builder for a bidirectional pattern synonym]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For a bidirectional pattern synonym we need to produce an /expression/
    that matches the supplied /pattern/, given values for the arguments
    of the pattern synonym.  For example
      pattern F x y = (Just x, [y])
    The 'builder' for F looks like
      $builderF x y = (Just x, [y])

    We can't always do this:
     * Some patterns aren't invertible; e.g. view patterns
          pattern F x = (reverse -> x:_)

     * The RHS pattern might bind more variables than the pattern
       synonym, so again we can't invert it
          pattern F x = (x,y)

     * Ditto wildcards
          pattern F x = (x,_)

    Note [Redundant constraints for builder]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The builder can have redundant constraints, which are awkward to eliminate.
    Consider
       pattern P = Just 34
    To match against this pattern we need (Eq a, Num a).  But to build
    (Just 34) we need only (Num a).  Fortunately instTcSigFromId sets
    sig_warn_redundant to False.

    ************************************************************************
    *                                                                      *
             Helper functions
    *                                                                      *
    ************************************************************************

    Note [As-patterns in pattern synonym definitions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The rationale for rejecting as-patterns in pattern synonym definitions
    is that an as-pattern would introduce nonindependent pattern synonym
    arguments, e.g. given a pattern synonym like:

            pattern K x y = x@(Just y)

    one could write a nonsensical function like

            f (K Nothing x) = ...

    or
            g (K (Just True) False) = ...

    Note [Type signatures and the builder expression]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       pattern L x = Left x :: Either [a] [b]

    In tc{Infer/Check}PatSynDecl we will check that the pattern has the
    specified type.  We check the pattern *as a pattern*, so the type
    signature is a pattern signature, and so brings 'a' and 'b' into
    scope.  But we don't have a way to bind 'a, b' in the LHS, as we do
    'x', say.  Nevertheless, the signature may be useful to constrain
    the type.

    When making the binding for the *builder*, though, we don't want
      $buildL x = Left x :: Either [a] [b]
    because that wil either mean (forall a b. Either [a] [b]), or we'll
    get a complaint that 'a' and 'b' are out of scope. (Actually the
    latter; #9867.)  No, the job of the signature is done, so when
    converting the pattern to an expression (for the builder RHS) we
    simply discard the signature.

    Note [Record PatSyn Desugaring]
    -------------------------------
    It is important that prov_theta comes before req_theta as this ordering is used
    when desugaring record pattern synonym updates.

    Any change to this ordering should make sure to change GHC.HsToCore.Expr if you
    want to avoid difficult to decipher core lint errors!
     -}

    nonBidirectionalErr :: Outputable name => name -> TcM a
    nonBidirectionalErr :: forall name a. Outputable name => name -> TcM a
    nonBidirectionalErr name
    name = MsgDoc -> TcM a
    forall a. MsgDoc -> TcM a
    failWithTc (MsgDoc -> TcM a) -> MsgDoc -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        String -> MsgDoc
    text String
    "non-bidirectional pattern synonym"
        MsgDoc -> MsgDoc -> MsgDoc
    <+> MsgDoc -> MsgDoc
    quotes (name -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr name
    name) MsgDoc -> MsgDoc -> MsgDoc
    <+> String -> MsgDoc
    text String
    "used in an expression"

    -- Walk the whole pattern and for all ConPatOuts, collect the
    -- existentially-bound type variables and evidence binding variables.
    --
    -- These are used in computing the type of a pattern synonym and also
    -- in generating matcher functions, since success continuations need
    -- to be passed these pattern-bound evidences.
    tcCollectEx
      :: LPat GhcTc
      -> ( [TyVar]        -- Existentially-bound type variables
                          -- in correctly-scoped order; e.g. [ k:*, x:k ]
         , [EvVar] )      -- and evidence variables

    tcCollectEx :: LPat GhcTc -> ([Id], [Id])
    tcCollectEx LPat GhcTc
    pat = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    pat
      where
        go :: LPat GhcTc -> ([TyVar], [EvVar])
        go :: LPat GhcTc -> ([Id], [Id])
    go = Pat GhcTc -> ([Id], [Id])
    go1 (Pat GhcTc -> ([Id], [Id]))
    -> (Located (Pat GhcTc) -> Pat GhcTc)
    -> Located (Pat GhcTc)
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc

        go1 :: Pat GhcTc -> ([TyVar], [EvVar])
        go1 :: Pat GhcTc -> ([Id], [Id])
    go1 (LazyPat XLazyPat GhcTc
    _ LPat GhcTc
    p)      = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (AsPat XAsPat GhcTc
    _ Located (IdP GhcTc)
    _ LPat GhcTc
    p)      = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (ParPat XParPat GhcTc
    _ LPat GhcTc
    p)       = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (BangPat XBangPat GhcTc
    _ LPat GhcTc
    p)      = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (ListPat XListPat GhcTc
    _ [LPat GhcTc]
    ps)     = [([Id], [Id])] -> ([Id], [Id])
    forall {a} {a}. [([a], [a])] -> ([a], [a])
    mergeMany ([([Id], [Id])] -> ([Id], [Id]))
    -> ([Located (Pat GhcTc)] -> [([Id], [Id])])
    -> [Located (Pat GhcTc)]
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located (Pat GhcTc) -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map Located (Pat GhcTc) -> ([Id], [Id])
    LPat GhcTc -> ([Id], [Id])
    go ([Located (Pat GhcTc)] -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [Located (Pat GhcTc)]
    [LPat GhcTc]
    ps
        go1 (TuplePat XTuplePat GhcTc
    _ [LPat GhcTc]
    ps Boxity
    _)  = [([Id], [Id])] -> ([Id], [Id])
    forall {a} {a}. [([a], [a])] -> ([a], [a])
    mergeMany ([([Id], [Id])] -> ([Id], [Id]))
    -> ([Located (Pat GhcTc)] -> [([Id], [Id])])
    -> [Located (Pat GhcTc)]
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located (Pat GhcTc) -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map Located (Pat GhcTc) -> ([Id], [Id])
    LPat GhcTc -> ([Id], [Id])
    go ([Located (Pat GhcTc)] -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [Located (Pat GhcTc)]
    [LPat GhcTc]
    ps
        go1 (SumPat XSumPat GhcTc
    _ LPat GhcTc
    p Int
    _ Int
    _)   = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (ViewPat XViewPat GhcTc
    _ LHsExpr GhcTc
    _ LPat GhcTc
    p)    = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 con :: Pat GhcTc
    con@ConPat{ pat_con_ext :: forall p. Pat p -> XConPat p
    pat_con_ext = XConPat GhcTc
    con' }
                               = ([Id], [Id]) -> ([Id], [Id]) -> ([Id], [Id])
    forall {a} {a}. ([a], [a]) -> ([a], [a]) -> ([a], [a])
    merge (ConPatTc -> [Id]
    cpt_tvs XConPat GhcTc
    ConPatTc
    con', ConPatTc -> [Id]
    cpt_dicts XConPat GhcTc
    ConPatTc
    con') (([Id], [Id]) -> ([Id], [Id])) -> ([Id], [Id]) -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $
                                  HsConPatDetails GhcTc -> ([Id], [Id])
    goConDetails (HsConPatDetails GhcTc -> ([Id], [Id]))
    -> HsConPatDetails GhcTc -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ Pat GhcTc -> HsConPatDetails GhcTc
    forall p. Pat p -> HsConPatDetails p
    pat_args Pat GhcTc
    con
        go1 (SigPat XSigPat GhcTc
    _ LPat GhcTc
    p HsPatSigType (NoGhcTc GhcTc)
    _)     = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p
        go1 (XPat (CoPat HsWrapper
    _ Pat GhcTc
    p Kind
    _)) = Pat GhcTc -> ([Id], [Id])
    go1 Pat GhcTc
    p
        go1 (NPlusKPat XNPlusKPat GhcTc
    _ Located (IdP GhcTc)
    n Located (HsOverLit GhcTc)
    k HsOverLit GhcTc
    _ SyntaxExpr GhcTc
    geq SyntaxExpr GhcTc
    subtract)
          = String -> MsgDoc -> ([Id], [Id])
    forall a. HasCallStack => String -> MsgDoc -> a
    pprPanic String
    "TODO: NPlusKPat" (MsgDoc -> ([Id], [Id])) -> MsgDoc -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ Located Id -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Located Id
    Located (IdP GhcTc)
    n MsgDoc -> MsgDoc -> MsgDoc
    $$ Located (HsOverLit GhcTc) -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr Located (HsOverLit GhcTc)
    k MsgDoc -> MsgDoc -> MsgDoc
    $$ SyntaxExprTc -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr SyntaxExpr GhcTc
    SyntaxExprTc
    geq MsgDoc -> MsgDoc -> MsgDoc
    $$ SyntaxExprTc -> MsgDoc
    forall a. Outputable a => a -> MsgDoc
    ppr SyntaxExpr GhcTc
    SyntaxExprTc
    subtract
        go1 Pat GhcTc
    _                   = ([Id], [Id])
    forall {a} {a}. ([a], [a])
    empty

        goConDetails :: HsConPatDetails GhcTc -> ([TyVar], [EvVar])
        goConDetails :: HsConPatDetails GhcTc -> ([Id], [Id])
    goConDetails (PrefixCon [LPat GhcTc]
    ps) = [([Id], [Id])] -> ([Id], [Id])
    forall {a} {a}. [([a], [a])] -> ([a], [a])
    mergeMany ([([Id], [Id])] -> ([Id], [Id]))
    -> ([Located (Pat GhcTc)] -> [([Id], [Id])])
    -> [Located (Pat GhcTc)]
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Located (Pat GhcTc) -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map Located (Pat GhcTc) -> ([Id], [Id])
    LPat GhcTc -> ([Id], [Id])
    go ([Located (Pat GhcTc)] -> ([Id], [Id]))
    -> [Located (Pat GhcTc)] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [Located (Pat GhcTc)]
    [LPat GhcTc]
    ps
        goConDetails (InfixCon LPat GhcTc
    p1 LPat GhcTc
    p2) = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p1 ([Id], [Id]) -> ([Id], [Id]) -> ([Id], [Id])
    forall {a} {a}. ([a], [a]) -> ([a], [a]) -> ([a], [a])
    `merge` LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p2
        goConDetails (RecCon HsRecFields{ rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
    rec_flds = [LHsRecField GhcTc (LPat GhcTc)]
    flds })
          = [([Id], [Id])] -> ([Id], [Id])
    forall {a} {a}. [([a], [a])] -> ([a], [a])
    mergeMany ([([Id], [Id])] -> ([Id], [Id]))
    -> ([LHsRecField GhcTc (Located (Pat GhcTc))] -> [([Id], [Id])])
    -> [LHsRecField GhcTc (Located (Pat GhcTc))]
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LHsRecField GhcTc (Located (Pat GhcTc)) -> ([Id], [Id]))
    -> [LHsRecField GhcTc (Located (Pat GhcTc))] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsRecField GhcTc (Located (Pat GhcTc)) -> ([Id], [Id])
    LHsRecField GhcTc (LPat GhcTc) -> ([Id], [Id])
    goRecFd ([LHsRecField GhcTc (Located (Pat GhcTc))] -> ([Id], [Id]))
    -> [LHsRecField GhcTc (Located (Pat GhcTc))] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [LHsRecField GhcTc (Located (Pat GhcTc))]
    [LHsRecField GhcTc (LPat GhcTc)]
    flds

        goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([TyVar], [EvVar])
        goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([Id], [Id])
    goRecFd (L SrcSpan
    _ HsRecField{ hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg = LPat GhcTc
    p }) = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    p

        merge :: ([a], [a]) -> ([a], [a]) -> ([a], [a])
    merge ([a]
    vs1, [a]
    evs1) ([a]
    vs2, [a]
    evs2) = ([a]
    vs1 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    vs2, [a]
    evs1 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    evs2)
        mergeMany :: [([a], [a])] -> ([a], [a])
    mergeMany = (([a], [a]) -> ([a], [a]) -> ([a], [a]))
    -> ([a], [a]) -> [([a], [a])] -> ([a], [a])
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ([a], [a]) -> ([a], [a]) -> ([a], [a])
    forall {a} {a}. ([a], [a]) -> ([a], [a]) -> ([a], [a])
    merge ([a], [a])
    forall {a} {a}. ([a], [a])
    empty
        empty :: ([a], [a])
    empty     = ([], [])