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

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

    -}

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

    import GHC.Prelude

    import GHC.Hs

    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Zonk.Type
    import GHC.Tc.Errors.Types
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Zonk.TcType
    import GHC.Tc.Gen.Sig ( TcPragEnv, emptyPragEnv, completeSigFromId, lookupPragEnv
                          , addInlinePrags, addInlinePragArity )
    import GHC.Tc.Solver
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.Origin
    import GHC.Tc.TyCl.Build

    import GHC.Core.Multiplicity
    import GHC.Core.Type ( typeKind, tidyForAllTyBinders, tidyTypes, tidyType, isManyTy, mkTYPEapp )
    import GHC.Core.TyCo.Subst( extendTvSubstWithClone )
    import GHC.Core.Predicate

    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Types.SrcLoc
    import GHC.Core.PatSyn
    import GHC.Utils.Panic
    import GHC.Utils.Outputable
    import GHC.Data.FastString
    import GHC.Types.Var
    import GHC.Types.Var.Env( emptyTidyEnv, mkInScopeSetList )
    import GHC.Types.Id
    import GHC.Types.Id.Info( RecSelParent(..) )
    import GHC.Tc.Gen.Bind
    import GHC.Types.Basic
    import GHC.Builtin.Types
    import GHC.Types.Var.Set
    import GHC.Tc.TyCl.Utils
    import GHC.Core.ConLike
    import GHC.Types.FieldLabel
    import GHC.Rename.Env
    import GHC.Rename.Utils (wrapGenSpan, isIrrefutableHsPat)
    import GHC.Data.Bag
    import GHC.Utils.Misc
    import GHC.Driver.DynFlags ( getDynFlags, xopt_FieldSelectors )
    import Data.Maybe( mapMaybe )
    import Control.Monad ( zipWithM )
    import Data.List( partition, mapAccumL )
    import Data.List.NonEmpty (NonEmpty, nonEmpty)

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

    tcPatSynDecl :: LocatedA (PatSynBind GhcRn GhcRn)
                 -> TcSigFun
                 -> TcPragEnv -- See Note [Pragmas for pattern synonyms]
                 -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcPatSynDecl :: LocatedA (PatSynBind GhcRn GhcRn)
    -> TcSigFun -> TcPragEnv -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcPatSynDecl (L SrcSpanAnnA
    loc psb :: PatSynBind GhcRn GhcRn
    psb@(PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
    psb_id = L SrcSpanAnnN
    _ Name
    name })) TcSigFun
    sig_fn TcPragEnv
    prag_fn
      = SrcSpanAnnA
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        SDoc
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In the declaration for pattern synonym"
                    SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)) (TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv))
    -> TcM (LHsBinds GhcTc, TcGblEnv) -> TcM (LHsBinds GhcTc, TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        -- See Note [Pattern synonym error recovery]
        case TcSigFun
    sig_fn Name
    name of
          Maybe TcSigInfo
    Nothing                   -> PatSynBind GhcRn GhcRn
    -> TcPragEnv -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl PatSynBind GhcRn GhcRn
    psb TcPragEnv
    prag_fn
          Just (TcPatSynSig TcPatSynSig
    patsig) -> PatSynBind GhcRn GhcRn
    -> TcPatSynSig -> TcPragEnv -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl PatSynBind GhcRn GhcRn
    psb TcPatSynSig
    patsig TcPragEnv
    prag_fn
          Maybe TcSigInfo
    _                         -> String
    -> TcM
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)), TcGblEnv)
    forall a. HasCallStack => String -> a
    panic String
    "tcPatSynDecl"

    {- 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 unification 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.

    Unlike for value bindings, we don't create a placeholder pattern
    synonym binding in an attempt to recover from the error, as this placeholder
    was occasionally the cause of strange follow-up errors to occur, as reported in #23467.
    It seems rather difficult to come up with a satisfactory placeholder:

      - it would need to have the right number of arguments,
        with the appropriate field names (if any),
      - we could give each argument the type `forall a. a`; this would generally
        work OK in pattern occurrences of the PatSyn, but not so in expressions,
        e.g. "let x = Con y" would require (y :: forall a. a) which would cause
        confusing errors.

    So, for now at least, we don't attempt to recover at all.
    -}

    tcInferPatSynDecl :: PatSynBind GhcRn GhcRn
                      -> TcPragEnv
                      -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl :: PatSynBind GhcRn GhcRn
    -> TcPragEnv -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcInferPatSynDecl (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
    psb_id = lname :: LIdP GhcRn
    lname@(L SrcSpanAnnN
    _ Name
    name), psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
    psb_args = HsPatSynDetails 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 })
                      TcPragEnv
    prag_fn
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcInferPatSynDecl {" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name

           ; let ([Name]
    arg_names, Bool
    is_infix) = HsPatSynDetails GhcRn -> ([Name], Bool)
    collectPatSynArgInfo HsPatSynDetails GhcRn
    details
           ; (tclvl, wanted, ((lpat', args), pat_ty))
                <- TcM ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind)
    -> TcM
         (TcLevel, WantedConstraints,
          ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind))
    forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints      (TcM ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind)
     -> TcM
          (TcLevel, WantedConstraints,
           ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind)))
    -> TcM ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind)
    -> TcM
         (TcLevel, WantedConstraints,
          ((GenLocated SrcSpanAnnA (Pat GhcTc), [Id]), Kind))
    forall a b. (a -> b) -> a -> b
    $
                   FixedRuntimeRepContext
    -> HsMatchContextRn
    -> LPat GhcRn
    -> TcM [Id]
    -> TcM ((LPat GhcTc, [Id]), Kind)
    forall a.
    FixedRuntimeRepContext
    -> HsMatchContextRn
    -> LPat GhcRn
    -> TcM a
    -> TcM ((LPat GhcTc, a), Kind)
    tcInferPat FixedRuntimeRepContext
    FRRPatSynArg HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Name -> IOEnv (Env TcGblEnv TcLclEnv) Id
    tcLookupId [Name]
    arg_names

           ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'

                 named_taus = (Name
    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
    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]

           ; ((univ_tvs, req_dicts, ev_binds, _), residual)
                   <- captureConstraints $
                      simplifyInfer tclvl NoRestrictions [] named_taus wanted
           ; top_ev_binds <- checkNoErrs (simplifyTop residual)
           ; addTopEvBinds top_ev_binds $

        do { prov_dicts <- liftZonkM $ mapM zonkId prov_dicts
           ; let 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]
                 (prov_theta, prov_evs)
                     = unzip (mapMaybe mkProvEvidence filtered_prov_dicts)
                 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]
           ; args <- liftZonkM $ mapM zonkId args
           ; let bad_arg Id
    arg = (NonEmpty Id -> (Id, NonEmpty Id))
    -> Maybe (NonEmpty Id) -> Maybe (Id, NonEmpty Id)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\NonEmpty Id
    bad_cos -> (Id
    arg, NonEmpty Id
    bad_cos)) (Maybe (NonEmpty Id) -> Maybe (Id, NonEmpty Id))
    -> Maybe (NonEmpty Id) -> Maybe (Id, NonEmpty Id)
    forall a b. (a -> b) -> a -> b
    $
                               [Id] -> Maybe (NonEmpty Id)
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Id] -> Maybe (NonEmpty Id)) -> [Id] -> Maybe (NonEmpty Id)
    forall a b. (a -> b) -> a -> b
    $
                               DVarSet -> [Id]
    dVarSetElems (DVarSet -> [Id]) -> DVarSet -> [Id]
    forall a b. (a -> b) -> a -> b
    $
                               (Id -> Bool) -> DVarSet -> DVarSet
    filterDVarSet Id -> Bool
    isId (Kind -> DVarSet
    tyCoVarsOfTypeDSet (Id -> Kind
    idType Id
    arg))
                 bad_args = (Id -> Maybe (Id, NonEmpty Id)) -> [Id] -> [(Id, NonEmpty Id)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Id -> Maybe (Id, NonEmpty Id)
    bad_arg ([Id]
    args [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    prov_dicts)
           ; mapM_ dependentArgErr bad_args

           -- Report un-quantifiable type variables:
           -- see Note [Unquantified tyvars in a pattern synonym]
           ; dvs <- candidateQTyVarsOfTypes prov_theta
           ; let err_ctx TidyEnv
    tidy_env
                   = do { (tidy_env2, theta) <- TidyEnv -> [Kind] -> ZonkM (TidyEnv, [Kind])
    zonkTidyTcTypes TidyEnv
    tidy_env [Kind]
    prov_theta
                        ; return ( tidy_env2, UninfTyCtx_ProvidedContext theta ) }
           ; doNotQuantifyTyVars dvs err_ctx

           ; traceTc "tcInferPatSynDecl }" $ (ppr name $$ ppr ex_tvs)
           ; rec_fields <- lookupConstructorFields name
           ; tc_patsyn_finish lname dir is_infix lpat' prag_fn
                              (mkTyVarBinders InferredSpec univ_tvs
                                , req_theta,  ev_binds, req_dicts)
                              (mkTyVarBinders InferredSpec ex_tvs
                                , mkTyVarTys ex_tvs, prov_theta, prov_evs)
                              (map nlHsVar args, map idType args)
                              pat_ty 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
    typeKind Kind
    ty1
            k2 :: Kind
    k2 = HasDebugCallStack => Kind -> Kind
    Kind -> Kind
    typeKind 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, NonEmpty CoVar) -> TcM ()
    -- See Note [Coercions that escape]
    dependentArgErr :: (Id, NonEmpty Id) -> TcRn ()
    dependentArgErr (Id
    arg, NonEmpty Id
    bad_cos)
      = TcRnMessage -> TcRn ()
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $  -- fail here: otherwise we get downstream errors
        Id -> NonEmpty Id -> TcRnMessage
    TcRnPatSynEscapedCoercion Id
    arg NonEmpty Id
    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 quantify 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/matcher are not inlined.

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

    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.

    Note [Unquantified tyvars in a pattern synonym]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#21479)

       data T a where MkT :: Int -> T Char   -- A GADT
       foo :: forall b. Bool -> T b          -- Somewhat strange type

       pattern T1 <- (foo -> MkT)

    In the view pattern, foo is instantiated, let's say b :-> b0
    where b0 is a unification variable.  Then matching the GADT
    MkT will add the "provided" constraint b0~Char, so we might infer
       pattern T1 :: () => (b0~Char) => Int -> Bool

    Nothing constrains that `b0`. We don't want to quantify over it.
    We don't want to to zonk to Any (we don't like Any showing up in
    user-visible types).  So we want to error here. See
    Note [Error on unconstrained meta-variables] in GHC.Tc.Utils.TcMType

    Hence the call to doNotQuantifyTyVars here.
    -}

    tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn
                      -> TcPatSynSig
                      -> TcPragEnv
                      -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl :: PatSynBind GhcRn GhcRn
    -> TcPatSynSig -> TcPragEnv -> TcM (LHsBinds GhcTc, TcGblEnv)
    tcCheckPatSynDecl psb :: PatSynBind GhcRn GhcRn
    psb@PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
    psb_id = lname :: LIdP GhcRn
    lname@(L SrcSpanAnnN
    _ Name
    name), psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
    psb_args = HsPatSynDetails 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 }
                      PatSig{ patsig_implicit_bndrs :: TcPatSynSig -> [VarBndr Id Specificity]
    patsig_implicit_bndrs = [VarBndr Id Specificity]
    implicit_bndrs
                            , patsig_univ_bndrs :: TcPatSynSig -> [VarBndr Id Specificity]
    patsig_univ_bndrs = [VarBndr Id Specificity]
    explicit_univ_bndrs, patsig_req :: TcPatSynSig -> [Kind]
    patsig_req  = [Kind]
    req_theta
                            , patsig_ex_bndrs :: TcPatSynSig -> [VarBndr Id Specificity]
    patsig_ex_bndrs   = [VarBndr Id Specificity]
    explicit_ex_bndrs,   patsig_prov :: TcPatSynSig -> [Kind]
    patsig_prov = [Kind]
    prov_theta
                            , patsig_body_ty :: TcPatSynSig -> Kind
    patsig_body_ty    = Kind
    sig_body_ty }
                      TcPragEnv
    prag_fn
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcCheckPatSynDecl" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ [VarBndr Id Specificity] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [VarBndr Id Specificity]
    implicit_bndrs, [VarBndr Id Specificity] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [VarBndr Id Specificity]
    explicit_univ_bndrs, [Kind] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Kind]
    req_theta
                  , [VarBndr Id Specificity] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [VarBndr Id Specificity]
    explicit_ex_bndrs, [Kind] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Kind]
    prov_theta, Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    sig_body_ty ]

           ; let decl_arity :: Int
    decl_arity = [Name] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    arg_names
                 ([Name]
    arg_names, Bool
    is_infix) = HsPatSynDetails GhcRn -> ([Name], Bool)
    collectPatSynArgInfo HsPatSynDetails GhcRn
    details

           ; (arg_tys, 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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    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
    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 (decl_arity above)
           ; let 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
           ; checkTc (null bad_tvs) $ TcRnPatSynExistentialInResult name pat_ty bad_tvs

             -- See Note [The pattern-synonym signature splitting rule] in GHC.Tc.Gen.Sig
           ; let 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))
                 (extra_univ, extra_ex) = partition ((`elemVarSet` univ_fvs) . binderVar) implicit_bndrs
                 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]
    extra_ex   [VarBndr Id Specificity]
    -> [VarBndr Id Specificity] -> [VarBndr Id Specificity]
    forall a. [a] -> [a] -> [a]
    ++ [VarBndr Id Specificity]
    explicit_ex_bndrs
                 univ_tvs   = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    univ_bndrs
                 ex_tvs     = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    ex_bndrs

             -- Pattern synonyms currently cannot be linear (#18806)
           ; checkTc (all (isManyTy . scaledMult) arg_tys) $
               TcRnLinearPatSyn sig_body_ty

           ; skol_info <- mkSkolemInfo (SigSkol (PatSynCtxt name) 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"

             -- Skolemise the quantified type variables. This is necessary
             -- in order to check the actual pattern type against the
             -- expected type. Even though the tyvars in the type are
             -- already skolems, this step changes their TcLevels,
             -- avoiding level-check errors when unifying.
           ; (skol_subst0, skol_univ_bndrs) <- skolemiseTvBndrsX skol_info emptySubst univ_bndrs
           ; (skol_subst, skol_ex_bndrs)    <- skolemiseTvBndrsX skol_info skol_subst0   ex_bndrs
           ; let skol_univ_tvs   = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    skol_univ_bndrs
                 skol_ex_tvs     = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr Id Specificity]
    skol_ex_bndrs
                 skol_req_theta  = HasDebugCallStack => Subst -> [Kind] -> [Kind]
    Subst -> [Kind] -> [Kind]
    substTheta Subst
    skol_subst0 [Kind]
    req_theta
                 skol_prov_theta = HasDebugCallStack => Subst -> [Kind] -> [Kind]
    Subst -> [Kind] -> [Kind]
    substTheta Subst
    skol_subst  [Kind]
    prov_theta
                 skol_arg_tys    = HasDebugCallStack => Subst -> [Kind] -> [Kind]
    Subst -> [Kind] -> [Kind]
    substTys   Subst
    skol_subst  ((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)
                 skol_pat_ty     = HasDebugCallStack => Subst -> Kind -> Kind
    Subst -> Kind -> Kind
    substTy    Subst
    skol_subst  Kind
    pat_ty

                 univ_tv_prs     = [ (Id -> Name
    forall a. NamedThing a => a -> Name
    getName Id
    orig_univ_tv, Id
    skol_univ_tv)
                                   | (Id
    orig_univ_tv, Id
    skol_univ_tv) <- [Id]
    univ_tvs [Id] -> [Id] -> [(Id, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    skol_univ_tvs ]

           -- Right!  Let's check the pattern against the signature
           -- See Note [Checking against a pattern signature]
           ; req_dicts <- newEvVars skol_req_theta
           ; (tclvl, wanted, (lpat', (ex_tvs', prov_dicts, args'))) <-
               assertPpr (equalLength arg_names arg_tys) (ppr name $$ ppr arg_names $$ ppr arg_tys) $
               pushLevelAndCaptureConstraints   $
               tcExtendNameTyVarEnv univ_tv_prs $
               tcCheckPat PatSyn lpat (unrestricted skol_pat_ty)   $
               do { let in_scope    = [Id] -> InScopeSet
    mkInScopeSetList [Id]
    skol_univ_tvs
                        empty_subst = InScopeSet -> Subst
    mkEmptySubst InScopeSet
    in_scope
                  ; (inst_subst, ex_tvs') <- mapAccumLM newMetaTyVarX empty_subst skol_ex_tvs
                        -- newMetaTyVarX: see the "Existential type variables"
                        -- part of Note [Checking against a pattern signature]
                  ; traceTc "tcpatsyn1" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs])
                  ; traceTc "tcpatsyn2" (vcat [ ppr v <+> dcolon <+> ppr (tyVarKind v) | v <- ex_tvs'])
                  ; let prov_theta' = HasDebugCallStack => Subst -> [Kind] -> [Kind]
    Subst -> [Kind] -> [Kind]
    substTheta Subst
    inst_subst [Kind]
    skol_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.
                  ; prov_dicts <- mapM (emitWanted (ProvCtxtOrigin psb)) prov_theta'
                  ; args'      <- zipWithM (tc_arg inst_subst) arg_names
                                           skol_arg_tys
                  ; return (ex_tvs', prov_dicts, args') }

           ; (implics, ev_binds) <- buildImplicationFor tclvl (getSkolemInfo skol_info) skol_univ_tvs
                                                        req_dicts wanted

           -- Solve the constraints now, because we are about to make a PatSyn,
           -- which should not contain unification variables and the like (#10997)
           ; simplifyTopImplic 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

           ; traceTc "tcCheckPatSynDecl }" $ ppr name

           ; rec_fields <- lookupConstructorFields name
           ; tc_patsyn_finish lname dir is_infix lpat' prag_fn
                              (skol_univ_bndrs, skol_req_theta, ev_binds, req_dicts)
                              (skol_ex_bndrs, mkTyVarTys ex_tvs', skol_prov_theta, prov_dicts)
                              (args', skol_arg_tys)
                              skol_pat_ty rec_fields }
      where
        tc_arg :: Subst -> Name -> Type -> TcM (LHsExpr GhcTc)
         -- Look up the variable actually bound by lpat
         -- and check that it has the expected type
        tc_arg :: Subst -> Name -> Kind -> TcM (LHsExpr GhcTc)
    tc_arg Subst
    subst Name
    arg_name Kind
    arg_ty
          = SrcSpan -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (Name -> SrcSpan
    nameSrcSpan Name
    arg_name) (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
               -- Set the SrcSpan to be the binding site of the Id (#18856)
               -- e.g.  pattern P :: Int -> Maybe (Int,Bool)
               --       pattern P x = Just (x,True)
               -- Before unifying x's actual type with its expected type, in tc_arg, set
               -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
               -- Else the error message location is wherever tcCheckPat finished,
               -- namely the right-hand corner of the pattern
            do { arg_id <- Name -> IOEnv (Env TcGblEnv TcLclEnv) Id
    tcLookupId Name
    arg_name
               ; wrap <- tcSubTypeSigma (OccurrenceOf (idName arg_id))
                                        GenSigCtxt
                                        (idType arg_id)
                                        (substTy subst arg_ty)
                    -- Why do we need tcSubType here?
                    -- See Note [Pattern synonyms and higher rank types]
               ; return (mkLHsWrap wrap $ nlHsVar arg_id) }

    skolemiseTvBndrsX :: SkolemInfo -> Subst -> [VarBndr TyVar flag]
                      -> TcM (Subst, [VarBndr TcTyVar flag])
    -- Make new TcTyVars, all skolems with levels, but do not clone
    -- The level is one level deeper than the current level
    -- See Note [Skolemising when checking a pattern synonym]
    skolemiseTvBndrsX :: forall flag.
    SkolemInfo
    -> Subst -> [VarBndr Id flag] -> TcM (Subst, [VarBndr Id flag])
    skolemiseTvBndrsX SkolemInfo
    skol_info Subst
    orig_subst [VarBndr Id flag]
    tvs
      = do { tc_lvl <- TcM TcLevel
    getTcLevel
           ; let pushed_lvl = TcLevel -> TcLevel
    pushTcLevel TcLevel
    tc_lvl
                 details    = SkolemInfo -> TcLevel -> Bool -> TcTyVarDetails
    SkolemTv SkolemInfo
    skol_info TcLevel
    pushed_lvl Bool
    False

                 mk_skol_tv_x :: Subst -> VarBndr TyVar flag
                              -> (Subst, VarBndr TcTyVar flag)
                 mk_skol_tv_x Subst
    subst (Bndr Id
    tv flag
    flag)
                   = (Subst
    subst', Id -> flag -> VarBndr Id flag
    forall var argf. var -> argf -> VarBndr var argf
    Bndr Id
    new_tv flag
    flag)
                   where
                     new_kind :: Kind
    new_kind = Subst -> Kind -> Kind
    substTyUnchecked Subst
    subst (Id -> Kind
    tyVarKind Id
    tv)
                     new_tv :: Id
    new_tv   = Name -> Kind -> TcTyVarDetails -> Id
    mkTcTyVar (Id -> Name
    tyVarName Id
    tv) Kind
    new_kind TcTyVarDetails
    details
                     subst' :: Subst
    subst'   = Subst -> Id -> Id -> Subst
    extendTvSubstWithClone Subst
    subst Id
    tv Id
    new_tv

           ; return (mapAccumL mk_skol_tv_x orig_subst tvs) }

    {- Note [Skolemising when checking a pattern synonym]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       pattern P1 :: forall a. a -> Maybe a
       pattern P1 x <- Just x where
          P1 x = Just (x :: a)

    The scoped type variable 'a' scopes over the builder RHS, Just (x::a).
    But the builder RHS is typechecked much later in tcPatSynBuilderBind,
    and gets its scoped type variables from the type of the builder_id.
    The easiest way to achieve this is not to clone when skolemising.

    Hence a special-purpose skolemiseTvBndrX here, similar to
    GHC.Tc.Utils.Instantiate.tcInstSkolTyVarsX except that the latter
    does cloning.

    Note [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 TcPatSynSig 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 GhcRn
                         -> ([Name], Bool)
    collectPatSynArgInfo :: HsPatSynDetails GhcRn -> ([Name], Bool)
    collectPatSynArgInfo HsPatSynDetails GhcRn
    details =
      case HsPatSynDetails GhcRn
    details of
        PrefixCon [Void]
    _ [LIdP GhcRn]
    names    -> ((GenLocated SrcSpanAnnN Name -> Name)
    -> [GenLocated SrcSpanAnnN Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [LIdP GhcRn]
    [GenLocated SrcSpanAnnN Name]
    names, Bool
    False)
        InfixCon LIdP GhcRn
    name1 LIdP GhcRn
    name2 -> ((GenLocated SrcSpanAnnN Name -> Name)
    -> [GenLocated SrcSpanAnnN Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [LIdP GhcRn
    GenLocated SrcSpanAnnN Name
    name1, LIdP GhcRn
    GenLocated SrcSpanAnnN Name
    name2], Bool
    True)
        RecCon [RecordPatSynField GhcRn]
    names         -> ((RecordPatSynField GhcRn -> Name)
    -> [RecordPatSynField GhcRn] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpanAnnN Name -> Name)
    -> (RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name)
    -> RecordPatSynField GhcRn
    -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RecordPatSynField GhcRn -> LIdP GhcRn
    RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name
    forall pass. RecordPatSynField pass -> LIdP pass
    recordPatSynPatVar) [RecordPatSynField GhcRn]
    names, Bool
    False)

    wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a
    wrongNumberOfParmsErr :: forall a. Name -> Int -> Int -> TcM a
    wrongNumberOfParmsErr Name
    name Int
    decl_arity Int
    missing
      = TcRnMessage -> TcM a
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> TcM a) -> TcRnMessage -> TcM a
    forall a b. (a -> b) -> a -> b
    $ Name -> Int -> Int -> TcRnMessage
    TcRnPatSynArityMismatch Name
    name Int
    decl_arity Int
    missing

    -------------------------
    -- Shared by both tcInferPatSyn and tcCheckPatSyn
    tc_patsyn_finish :: LocatedN Name   -- ^ PatSyn Name
                     -> HsPatSynDir GhcRn -- ^ PatSyn type (Uni/Bidir/ExplicitBidir)
                     -> Bool              -- ^ Whether infix
                     -> LPat GhcTc        -- ^ Pattern of the PatSyn
                     -> TcPragEnv
                     -> ([TcInvisTVBinder], [PredType], TcEvBinds, [EvVar])
                     -> ([TcInvisTVBinder], [TcType], [PredType], [EvTerm])
                     -> ([LHsExpr GhcTc], [TcTypeFRR])
                       -- ^ Pattern arguments and types.
                       -- These must have a syntactically fixed RuntimeRep as per
                       -- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
                     -> TcType            -- ^ Pattern type
                     -> [FieldLabel]      -- ^ Selector names
                     -- ^ Whether fields, empty if not record PatSyn
                     -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish :: GenLocated SrcSpanAnnN Name
    -> HsPatSynDir GhcRn
    -> Bool
    -> LPat GhcTc
    -> TcPragEnv
    -> ([VarBndr Id Specificity], [Kind], TcEvBinds, [Id])
    -> ([VarBndr Id Specificity], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> [FieldLabel]
    -> TcM (LHsBinds GhcTc, TcGblEnv)
    tc_patsyn_finish GenLocated SrcSpanAnnN Name
    lname HsPatSynDir GhcRn
    dir Bool
    is_infix LPat GhcTc
    lpat' TcPragEnv
    prag_fn
                     ([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 [FieldLabel]
    field_labels
      = do { -- Zonk everything.  We are about to build a final PatSyn
             -- so there had better be no unification variables in there

           (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, pat_ty) <-
             ZonkFlexi
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
          [Kind], [Kind], Kind)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
          [Kind], [Kind], Kind)
    forall (m :: * -> *) b. MonadIO m => ZonkFlexi -> ZonkT m b -> m b
    initZonkEnv ZonkFlexi
    NoFlexi (ZonkT
       (IOEnv (Env TcGblEnv TcLclEnv))
       ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
        [Kind], [Kind], Kind)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
           [Kind], [Kind], Kind))
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
          [Kind], [Kind], Kind)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
          [Kind], [Kind], Kind)
    forall a b. (a -> b) -> a -> b
    $
             ZonkBndrT (IOEnv (Env TcGblEnv TcLclEnv)) [VarBndr Id Specificity]
    -> forall r.
       ([VarBndr Id Specificity]
        -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r)
       -> ZonkT (IOEnv (Env TcGblEnv TcLclEnv)) r
    forall (m :: * -> *) a.
    ZonkBndrT m a -> forall r. (a -> ZonkT m r) -> ZonkT m r
    runZonkBndrT ([VarBndr Id Specificity]
    -> ZonkBndrT
         (IOEnv (Env TcGblEnv TcLclEnv)) [VarBndr Id Specificity]
    forall vis. [VarBndr Id vis] -> ZonkBndrTcM [VarBndr Id vis]
    zonkTyVarBindersX   [VarBndr Id Specificity]
    univ_tvs) (([VarBndr Id Specificity]
      -> ZonkT
           (IOEnv (Env TcGblEnv TcLclEnv))
           ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
            [Kind], [Kind], Kind))
     -> ZonkT
          (IOEnv (Env TcGblEnv TcLclEnv))
          ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
           [Kind], [Kind], Kind))
    -> ([VarBndr Id Specificity]
        -> ZonkT
             (IOEnv (Env TcGblEnv TcLclEnv))
             ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
              [Kind], [Kind], Kind))
    -> ZonkT
         (IOEnv (Env TcGblEnv TcLclEnv))
         ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
          [Kind], [Kind], Kind)
    forall a b. (a -> b) -> a -> b
    $ \ [VarBndr Id Specificity]
    univ_tvs' ->
             do { req_theta'  <- [Kind] -> ZonkTcM [Kind]
    zonkTcTypesToTypesX [Kind]
    req_theta
                ; runZonkBndrT (zonkTyVarBindersX ex_tvs) $ \ [VarBndr Id Specificity]
    ex_tvs' ->
             do { prov_theta' <- [Kind] -> ZonkTcM [Kind]
    zonkTcTypesToTypesX [Kind]
    prov_theta
                ; pat_ty'     <- zonkTcTypeToTypeX   pat_ty
                ; arg_tys'    <- zonkTcTypesToTypesX arg_tys

                ; let (env1, univ_tvs) = tidyForAllTyBinders emptyTidyEnv univ_tvs'
                      (env2, ex_tvs)   = tidyForAllTyBinders env1 ex_tvs'
                      req_theta  = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    req_theta'
                      prov_theta = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    prov_theta'
                      arg_tys    = TidyEnv -> [Kind] -> [Kind]
    tidyTypes TidyEnv
    env2 [Kind]
    arg_tys'
                      pat_ty     = TidyEnv -> Kind -> Kind
    tidyType  TidyEnv
    env2 Kind
    pat_ty'

                ; return (univ_tvs, req_theta,
                           ex_tvs, prov_theta, arg_tys, pat_ty) } }

           ; traceTc "tc_patsyn_finish {" $
               ppr (unLoc lname) $$ ppr (unLoc lpat') $$
               ppr (univ_tvs, req_theta, req_ev_binds, req_dicts) $$
               ppr (ex_tvs, prov_theta, prov_dicts) $$
               ppr args $$
               ppr arg_tys $$
               ppr pat_ty

           -- Make the 'matcher'
           ; (matcher, matcher_bind) <- tcPatSynMatcher lname lpat' prag_fn
                                             (binderVars univ_tvs, req_theta, req_ev_binds, req_dicts)
                                             (binderVars ex_tvs, ex_tys, prov_theta, prov_dicts)
                                             (args, arg_tys)
                                             pat_ty

           -- Make the 'builder'
           ; builder <- mkPatSynBuilder dir lname
                                        univ_tvs req_theta
                                        ex_tvs   prov_theta
                                        arg_tys pat_ty

           -- Make the PatSyn itself
           ; let patSyn = Name
    -> Bool
    -> ([VarBndr Id Specificity], [Kind])
    -> ([VarBndr Id Specificity], [Kind])
    -> [Kind]
    -> Kind
    -> PatSynMatcher
    -> PatSynBuilder
    -> [FieldLabel]
    -> PatSyn
    mkPatSyn (GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnN 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
                            PatSynMatcher
    matcher PatSynBuilder
    builder
                            [FieldLabel]
    field_labels

           -- Selectors
           ; has_sel <- xopt_FieldSelectors <$> getDynFlags
           ; let rn_rec_sel_binds = PatSyn -> [FieldLabel] -> FieldSelectors -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds PatSyn
    patSyn (PatSyn -> [FieldLabel]
    patSynFieldLabels PatSyn
    patSyn) FieldSelectors
    has_sel
                 tything = ConLike -> TyThing
    AConLike (PatSyn -> ConLike
    PatSynCon PatSyn
    patSyn)
           ; tcg_env <- tcExtendGlobalEnv [tything] $
                        tcRecSelBinds rn_rec_sel_binds

           ; traceTc "tc_patsyn_finish }" empty
           ; return (matcher_bind, tcg_env) }

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

    tcPatSynMatcher :: LocatedN Name
                    -> LPat GhcTc
                    -> TcPragEnv
                    -> ([TcTyVar], ThetaType, TcEvBinds, [EvVar])
                    -> ([TcTyVar], [TcType], ThetaType, [EvTerm])
                    -> ([LHsExpr GhcTc], [TcType])
                    -> TcType
                    -> TcM (PatSynMatcher, LHsBinds GhcTc)
    -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
    tcPatSynMatcher :: GenLocated SrcSpanAnnN Name
    -> LPat GhcTc
    -> TcPragEnv
    -> ([Id], [Kind], TcEvBinds, [Id])
    -> ([Id], [Kind], [Kind], [EvTerm])
    -> ([LHsExpr GhcTc], [Kind])
    -> Kind
    -> TcM (PatSynMatcher, LHsBinds GhcTc)
    tcPatSynMatcher (L SrcSpanAnnN
    loc Name
    ps_name) LPat GhcTc
    lpat TcPragEnv
    prag_fn
                    ([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 { let loc' :: SrcSpan
    loc' = SrcSpanAnnN -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnN
    loc
           ; rr_name <- OccName -> SrcSpan -> TcM Name
    newNameAt (FastString -> OccName
    mkTyVarOccFS (String -> FastString
    fsLit String
    "rep")) SrcSpan
    loc'
           ; tv_name <- newNameAt (mkTyVarOccFS (fsLit "r"))   loc'
           ; let rr_tv  = Name -> Kind -> Id
    mkTyVar Name
    rr_name Kind
    runtimeRepTy
                 rr     = Id -> Kind
    mkTyVarTy Id
    rr_tv
                 res_tv = Name -> Kind -> Id
    mkTyVar Name
    tv_name (Kind -> Kind
    mkTYPEapp Kind
    rr)
                 res_ty = Id -> Kind
    mkTyVarTy Id
    res_tv
                 is_unlifted = [LocatedA (HsExpr GhcTc)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LHsExpr GhcTc]
    [LocatedA (HsExpr GhcTc)]
    args Bool -> Bool -> Bool
    && [EvTerm] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvTerm]
    prov_dicts
                 (cont_args, cont_arg_tys)
                   | is_unlifted = ([nlHsDataCon unboxedUnitDataCon], [unboxedUnitTy])
                   | otherwise   = (args,                             arg_tys)
                 cont_ty = [Id] -> [Kind] -> Kind -> Kind
    HasDebugCallStack => [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  = HasDebugCallStack => Kind -> Kind -> Kind
    Kind -> Kind -> Kind
    mkVisFunTyMany Kind
    unboxedUnitTy Kind
    res_ty

           ; matcher_name <- newImplicitBinder ps_name mkMatcherOcc
           ; scrutinee    <- newSysLocalId (fsLit "scrut") ManyTy pat_ty
           ; cont         <- newSysLocalId (fsLit "cont")  ManyTy cont_ty
           ; fail         <- newSysLocalId (fsLit "fail")  ManyTy fail_ty

           ; dflags       <- getDynFlags
           ; let matcher_tau   = [Kind] -> Kind -> Kind
    mkVisFunTysMany [Kind
    pat_ty, Kind
    cont_ty, Kind
    fail_ty] Kind
    res_ty
                 matcher_sigma = [Id] -> [Kind] -> Kind -> Kind
    HasDebugCallStack => [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    = Name -> Kind -> Id
    mkExportedVanillaId Name
    matcher_name Kind
    matcher_sigma
                 patsyn_id     = Name -> Kind -> Id
    mkExportedVanillaId Name
    ps_name Kind
    matcher_sigma
                                 -- See Note [Exported LocalIds] in GHC.Types.Id

                 inst_wrap = [EvTerm] -> HsWrapper
    mkWpEvApps [EvTerm]
    prov_dicts HsWrapper -> HsWrapper -> HsWrapper
    <.> [Kind] -> HsWrapper
    mkWpTyApps [Kind]
    ex_tys
                 cont' = (LocatedA (HsExpr GhcTc)
     -> LocatedA (HsExpr GhcTc) -> LocatedA (HsExpr GhcTc))
    -> LocatedA (HsExpr GhcTc)
    -> [LocatedA (HsExpr GhcTc)]
    -> LocatedA (HsExpr GhcTc)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    -> LocatedA (HsExpr GhcTc) -> LocatedA (HsExpr 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 (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar IdP GhcTc
    Id
    cont)) [LocatedA (HsExpr GhcTc)]
    cont_args

                 fail' = IdP GhcTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
    nlHsApps IdP GhcTc
    Id
    fail [DataCon -> LHsExpr GhcTc
    nlHsDataCon DataCon
    unboxedUnitDataCon]

                 args = (Id -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> [Id] -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    forall a b. (a -> b) -> [a] -> [b]
    map IdP GhcTc -> LPat GhcTc
    Id -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LPat (GhcPass p)
    nlVarPat [Id
    scrutinee, Id
    cont, Id
    fail]
                 lwpat = Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XWildPat GhcTc -> Pat GhcTc
    forall p. XWildPat p -> Pat p
    WildPat XWildPat GhcTc
    Kind
    pat_ty
                 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
    -> LocatedA (HsExpr GhcTc)
    -> LMatch GhcTc (LocatedA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt LPat GhcTc
    lpat  LocatedA (HsExpr GhcTc)
    cont']
                         else [LPat GhcTc
    -> LocatedA (HsExpr GhcTc)
    -> LMatch GhcTc (LocatedA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt LPat GhcTc
    lpat  LocatedA (HsExpr GhcTc)
    cont',
                               LPat GhcTc
    -> LocatedA (HsExpr GhcTc)
    -> LMatch GhcTc (LocatedA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkHsCaseAlt LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    lwpat LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    fail']
                 gen = GenReason -> DoPmc -> Origin
    Generated GenReason
    OtherExpansion DoPmc
    SkipPmc
                 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
    $
                        SrcSpanAnnA -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L (GenLocated SrcSpanAnnA (Pat GhcTc) -> SrcSpanAnnA
    forall l e. GenLocated l e -> l
    getLoc LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    lpat) (HsExpr GhcTc -> LocatedA (HsExpr GhcTc))
    -> HsExpr GhcTc -> LocatedA (HsExpr 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 XCase GhcTc
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    PatSyn (IdP GhcTc -> LHsExpr GhcTc
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar IdP GhcTc
    Id
    scrutinee) (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                        MG{ mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    mg_alts = SrcSpanAnnL
    -> [GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA -> SrcSpanAnnL
    forall a b. (HasLoc a, HasAnnotation b) => a -> b
    l2l (SrcSpanAnnA -> SrcSpanAnnL) -> SrcSpanAnnA -> SrcSpanAnnL
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (Pat GhcTc) -> SrcSpanAnnA
    forall l e. GenLocated l e -> l
    getLoc LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    lpat) [GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    cases
                          , mg_ext :: XMG GhcTc (LocatedA (HsExpr GhcTc))
    mg_ext = [Scaled Kind] -> Kind -> Origin -> MatchGroupTc
    MatchGroupTc [Kind -> Scaled Kind
    forall a. a -> Scaled a
    unrestricted Kind
    pat_ty] Kind
    res_ty Origin
    gen
                          }
                 body' = HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (HsExpr GhcTc -> LocatedA (HsExpr GhcTc))
    -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                         XLam GhcTc
    -> HsLamVariant -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p.
    XLam p -> HsLamVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam XLam GhcTc
    forall a. NoAnn a => a
    noAnn HsLamVariant
    LamSingle (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                         MG{ mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    mg_alts = [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    -> GenLocated
         (Anno
            [GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))])
         [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [HsMatchContext (LIdP (NoGhcTc GhcTc))
    -> [LPat GhcTc]
    -> LocatedA (HsExpr GhcTc)
    -> LMatch GhcTc (LocatedA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA,
     Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO) =>
    HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
    -> [LPat (GhcPass p)]
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkSimpleMatch (HsLamVariant
    -> HsMatchContext
         (GenLocated
            (Anno (IdGhcP (NoGhcTcPass 'Typechecked)))
            (IdGhcP (NoGhcTcPass 'Typechecked)))
    forall fn. HsLamVariant -> HsMatchContext fn
    LamAlt HsLamVariant
    LamSingle)
                                                             [LPat GhcTc]
    [GenLocated SrcSpanAnnA (Pat GhcTc)]
    args
                                                             LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    body]
                           , mg_ext :: XMG GhcTc (LocatedA (HsExpr GhcTc))
    mg_ext = [Scaled Kind] -> Kind -> Origin -> 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 Origin
    gen
                           }
                 match = HsMatchContext (LIdP (NoGhcTc GhcTc))
    -> [LPat GhcTc]
    -> LHsExpr GhcTc
    -> HsLocalBinds GhcTc
    -> LMatch GhcTc (LHsExpr GhcTc)
    forall (p :: Pass).
    IsPass p =>
    HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
    -> [LPat (GhcPass p)]
    -> LHsExpr (GhcPass p)
    -> HsLocalBinds (GhcPass p)
    -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
    mkMatch (GenLocated SrcSpanAnnN Name
    -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. fn -> HsMatchContext fn
    mkPrefixFunRhs (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc (Id -> Name
    idName Id
    patsyn_id))) []
                                 ([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
    LocatedA (HsExpr GhcTc)
    body')
                                 (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
    NoExtField
    noExtField)
                 mg :: MatchGroup GhcTc (LHsExpr GhcTc)
                 mg = MG{ mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    mg_alts = Anno
      [GenLocated
         (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
         (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
          (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    -> GenLocated
         (Anno
            [GenLocated
               (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
               (Match GhcTc (LocatedA (HsExpr GhcTc)))])
         [GenLocated
            (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
            (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnA
    -> Anno
         [GenLocated
            (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
            (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    forall a b. (HasLoc a, HasAnnotation b) => a -> b
    l2l (SrcSpanAnnA
     -> Anno
          [GenLocated
             (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
             (Match GhcTc (LocatedA (HsExpr GhcTc)))])
    -> SrcSpanAnnA
    -> Anno
         [GenLocated
            (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
            (Match GhcTc (LocatedA (HsExpr GhcTc)))]
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))
    -> SrcSpanAnnA
    forall l e. GenLocated l e -> l
    getLoc LMatch GhcTc (LHsExpr GhcTc)
    GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (HsExpr GhcTc)))
    match) [LMatch GhcTc (LHsExpr GhcTc)
    GenLocated
      (Anno (Match GhcTc (LocatedA (HsExpr GhcTc))))
      (Match GhcTc (LocatedA (HsExpr GhcTc)))
    match]
                        , mg_ext :: XMG GhcTc (LocatedA (HsExpr GhcTc))
    mg_ext = [Scaled Kind] -> Kind -> Origin -> MatchGroupTc
    MatchGroupTc [] Kind
    res_ty Origin
    gen
                        }
                 matcher_arity = [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    req_theta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3
                 -- See Note [Pragmas for pattern synonyms]

           -- Add INLINE pragmas; see Note [Pragmas for pattern synonyms]
           -- NB: prag_fn is keyed by the PatSyn Name, not the (internal) matcher name
           ; matcher_prag_id <- addInlinePrags matcher_id              $
                                map (addInlinePragArity matcher_arity) $
                                lookupPragEnv prag_fn ps_name

           ; let bind = FunBind{ fun_id :: LIdP GhcTc
    fun_id = SrcSpanAnnN -> Id -> GenLocated SrcSpanAnnN Id
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc Id
    matcher_prag_id
                               , fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
    fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
    mg
                               , fun_ext :: XFunBind GhcTc GhcTc
    fun_ext = (HsWrapper
    idHsWrapper, [])
                               }
                 matcher_bind = GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a. a -> Bag a
    unitBag (HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA HsBindLR GhcTc GhcTc
    bind)
           ; traceTc "tcPatSynMatcher" (ppr ps_name $$ ppr (idType matcher_id))
           ; traceTc "tcPatSynMatcher" (ppr matcher_bind)

           ; return ((matcher_name, matcher_sigma, is_unlifted), matcher_bind) }

    mkPatSynRecSelBinds :: PatSyn
                        -> [FieldLabel]  -- ^ Visible field labels
                        -> FieldSelectors
                        -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds :: PatSyn -> [FieldLabel] -> FieldSelectors -> [(Id, LHsBind GhcRn)]
    mkPatSynRecSelBinds PatSyn
    ps [FieldLabel]
    fields FieldSelectors
    has_sel
      = [ [ConLike]
    -> RecSelParent
    -> FieldLabel
    -> FieldSelectors
    -> (Id, LHsBind GhcRn)
    mkOneRecordSelector [PatSyn -> ConLike
    PatSynCon PatSyn
    ps] (PatSyn -> RecSelParent
    RecSelPatSyn PatSyn
    ps) FieldLabel
    fld_lbl FieldSelectors
    has_sel
        | 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
    *                                                                      *
    ************************************************************************
    -}

    mkPatSynBuilder :: HsPatSynDir a -> LocatedN Name
                    -> [InvisTVBinder] -> ThetaType
                    -> [InvisTVBinder] -> ThetaType
                    -> [Type] -> Type
                    -> TcM PatSynBuilder
    mkPatSynBuilder :: forall a.
    HsPatSynDir a
    -> GenLocated SrcSpanAnnN Name
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [VarBndr Id Specificity]
    -> [Kind]
    -> [Kind]
    -> Kind
    -> TcM PatSynBuilder
    mkPatSynBuilder HsPatSynDir a
    dir (L SrcSpanAnnN
    _ 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
      = PatSynBuilder -> TcM PatSynBuilder
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PatSynBuilder
    forall a. Maybe a
    Nothing
      | Bool
    otherwise
      = do { builder_name <- Name -> (OccName -> OccName) -> TcM Name
    forall m n. Name -> (OccName -> OccName) -> TcRnIf m n Name
    newImplicitBinder Name
    name OccName -> OccName
    mkBuilderOcc
           ; let theta          = [Kind]
    req_theta [Kind] -> [Kind] -> [Kind]
    forall a. [a] -> [a] -> [a]
    ++ [Kind]
    prov_theta
                 need_dummy_arg = HasDebugCallStack => Kind -> Bool
    Kind -> Bool
    isUnliftedType Kind
    pat_ty Bool -> Bool -> Bool
    && [Kind] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Kind]
    arg_tys Bool -> Bool -> Bool
    && [Kind] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Kind]
    theta
                                  -- NB: pattern arguments cannot be representation-polymorphic,
                                  -- as checked in 'tcPatSynSig'. So 'isUnliftedType' is OK here.
                 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
    HasDebugCallStack => [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

           ; return (Just (builder_name, builder_sigma, need_dummy_arg)) }

    tcPatSynBuilderBind :: TcPragEnv
                        -> PatSynBind GhcRn GhcRn
                        -> TcM (LHsBinds GhcTc)
    -- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
    tcPatSynBuilderBind :: TcPragEnv -> PatSynBind GhcRn GhcRn -> TcM (LHsBinds GhcTc)
    tcPatSynBuilderBind TcPragEnv
    prag_fn (PSB { psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
    psb_id = ps_lname :: LIdP GhcRn
    ps_lname@(L SrcSpanAnnN
    loc Name
    ps_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 idR
    psb_args = HsPatSynDetails GhcRn
    details })
      | HsPatSynDir GhcRn -> Bool
    forall a. HsPatSynDir a -> Bool
    isUnidirectional HsPatSynDir GhcRn
    dir
      = Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a. Bag a
    emptyBag

      | Left PatSynInvalidRhsReason
    why <- Either
      PatSynInvalidRhsReason
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    mb_match_group       -- Can't invert the pattern
      = SrcSpan -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (GenLocated SrcSpanAnnA (Pat GhcRn) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA LPat GhcRn
    GenLocated SrcSpanAnnA (Pat GhcRn)
    lpat) (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $ TcRnMessage -> TcM (LHsBinds GhcTc)
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> TcM (LHsBinds GhcTc))
    -> TcRnMessage -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $ Name
    -> LPat GhcRn
    -> [LIdP GhcRn]
    -> PatSynInvalidRhsReason
    -> TcRnMessage
    TcRnPatSynInvalidRhs Name
    ps_name LPat GhcRn
    lpat [LIdP GhcRn]
    args PatSynInvalidRhsReason
    why

      | Right MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    match_group <- Either
      PatSynInvalidRhsReason
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    mb_match_group  -- Bidirectional
      = do { patsyn <- Name -> TcM PatSyn
    tcLookupPatSyn Name
    ps_name
           ; case patSynBuilder patsyn of {
               PatSynBuilder
    Nothing -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc 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 (Name
    builder_name, Kind
    builder_ty, Bool
    need_dummy_arg) ->  -- Normal case
        do { -- Bidirectional, so patSynBuilder returns Just
             let builder_id :: Id
    builder_id = Name -> Kind -> Id
    mkExportedVanillaId Name
    builder_name Kind
    builder_ty
                             -- See Note [Exported LocalIds] in GHC.Types.Id

                 ([VarBndr Id Specificity]
    _, [Kind]
    req_theta, [VarBndr Id Specificity]
    _, [Kind]
    prov_theta, [Scaled Kind]
    arg_tys, Kind
    _) = PatSyn
    -> ([VarBndr Id Specificity], [Kind], [VarBndr Id Specificity],
        [Kind], [Scaled Kind], Kind)
    patSynSigBndr PatSyn
    patsyn
                 builder_arity :: Int
    builder_arity = [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    req_theta Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Kind]
    prov_theta
                                 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Scaled Kind] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Scaled Kind]
    arg_tys
                                 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (if Bool
    need_dummy_arg then Int
    1 else Int
    0)

           -- Add INLINE pragmas; see Note [Pragmas for pattern synonyms]
           -- NB: prag_fn is keyed by the PatSyn Name, not the (internal) builder name
           ; builder_id <- Id -> [LSig GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) Id
    addInlinePrags Id
    builder_id              ([LSig GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) Id)
    -> [LSig GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) Id
    forall a b. (a -> b) -> a -> b
    $
                           (LSig GhcRn -> LSig GhcRn) -> [LSig GhcRn] -> [LSig GhcRn]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> LSig GhcRn -> LSig GhcRn
    addInlinePragArity Int
    builder_arity) ([LSig GhcRn] -> [LSig GhcRn]) -> [LSig GhcRn] -> [LSig GhcRn]
    forall a b. (a -> b) -> a -> b
    $
                           TcPragEnv -> Name -> [LSig GhcRn]
    lookupPragEnv TcPragEnv
    prag_fn Name
    ps_name

           ; let match_group' | Bool
    need_dummy_arg = MatchGroup GhcRn (LHsExpr GhcRn)
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    add_dummy_arg MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    match_group
                              | Bool
    otherwise      = MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    match_group

                 bind = FunBind { fun_id :: LIdP GhcRn
    fun_id      = SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    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     = XFunBind GhcRn GhcRn
    NameSet
    emptyNameSet
                                }

                 sig = UserTypeCtxt -> Id -> TcCompleteSig
    completeSigFromId (Name -> UserTypeCtxt
    PatSynCtxt Name
    ps_name) Id
    builder_id

           ; traceTc "tcPatSynBuilderBind {" $
             vcat [ ppr patsyn
                  , ppr builder_id <+> dcolon <+> ppr (idType builder_id) ]
           ; (builder_binds, _) <- tcPolyCheck emptyPragEnv sig (noLocA bind)
           ; traceTc "tcPatSynBuilderBind }" $ ppr builder_binds
           ; return builder_binds } } }

      where
        mb_match_group :: Either
      PatSynInvalidRhsReason
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    mb_match_group
           = case HsPatSynDir GhcRn
    dir of
               ExplicitBidirectional MatchGroup GhcRn (LHsExpr GhcRn)
    explicit_mg -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Either
         PatSynInvalidRhsReason
         (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall a b. b -> Either a b
    Right MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    explicit_mg
               HsPatSynDir GhcRn
    ImplicitBidirectional -> (GenLocated SrcSpanAnnA (HsExpr GhcRn)
     -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Either
         PatSynInvalidRhsReason
         (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall a b.
    (a -> b)
    -> Either PatSynInvalidRhsReason a
    -> Either PatSynInvalidRhsReason b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    mk_mg ([GenLocated SrcSpanAnnN Name]
    -> LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    tcPatToExpr [LIdP GhcRn]
    [GenLocated SrcSpanAnnN Name]
    args LPat GhcRn
    lpat)
               HsPatSynDir GhcRn
    Unidirectional -> String
    -> Either
         PatSynInvalidRhsReason
         (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall a. HasCallStack => 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
    -> LocatedL
         [LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall (p :: Pass) (body :: * -> *).
    AnnoBody p body =>
    Origin
    -> LocatedL
         [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
    -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
    mkMatchGroup (GenReason -> DoPmc -> Origin
    Generated GenReason
    OtherExpansion DoPmc
    SkipPmc) ([LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> LocatedL
         [LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [LMatch GhcRn (LHsExpr GhcRn)
    LocatedA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    builder_match])
              where
                builder_args :: [GenLocated SrcSpanAnnA (Pat GhcRn)]
    builder_args  = [(SrcSpanAnnA -> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnN -> SrcSpanAnnA
    forall a b. (HasLoc a, HasAnnotation b) => a -> b
    l2l SrcSpanAnnN
    loc) (XVarPat GhcRn -> LIdP GhcRn -> Pat GhcRn
    forall p. XVarPat p -> LIdP p -> Pat p
    VarPat XVarPat GhcRn
    NoExtField
    noExtField (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc Name
    n)))
                                | L SrcSpanAnnN
    loc Name
    n <- [LIdP GhcRn]
    [GenLocated SrcSpanAnnN Name]
    args]
                builder_match :: LMatch GhcRn (LHsExpr GhcRn)
    builder_match = HsMatchContext (LIdP (NoGhcTc GhcRn))
    -> [LPat GhcRn]
    -> LHsExpr GhcRn
    -> HsLocalBinds GhcRn
    -> LMatch GhcRn (LHsExpr GhcRn)
    forall (p :: Pass).
    IsPass p =>
    HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
    -> [LPat (GhcPass p)]
    -> LHsExpr (GhcPass p)
    -> HsLocalBinds (GhcPass p)
    -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
    mkMatch (GenLocated
      (Anno (IdGhcP (NoGhcTcPass 'Renamed)))
      (IdGhcP (NoGhcTcPass 'Renamed))
    -> HsMatchContext
         (GenLocated
            (Anno (IdGhcP (NoGhcTcPass 'Renamed)))
            (IdGhcP (NoGhcTcPass 'Renamed)))
    forall fn. fn -> HsMatchContext fn
    mkPrefixFunRhs LIdP GhcRn
    GenLocated
      (Anno (IdGhcP (NoGhcTcPass 'Renamed)))
      (IdGhcP (NoGhcTcPass 'Renamed))
    ps_lname)
                                        [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    builder_args LHsExpr GhcRn
    body
                                        (XEmptyLocalBinds GhcRn GhcRn -> HsLocalBinds GhcRn
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds XEmptyLocalBinds GhcRn GhcRn
    NoExtField
    noExtField)

        args :: [LIdP GhcRn]
    args = case HsPatSynDetails GhcRn
    details of
                  PrefixCon [Void]
    _ [LIdP GhcRn]
    args   -> [LIdP GhcRn]
    args
                  InfixCon LIdP GhcRn
    arg1 LIdP GhcRn
    arg2 -> [LIdP GhcRn
    arg1, LIdP GhcRn
    arg2]
                  RecCon [RecordPatSynField GhcRn]
    args        -> (RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name)
    -> [RecordPatSynField GhcRn] -> [GenLocated SrcSpanAnnN Name]
    forall a b. (a -> b) -> [a] -> [b]
    map RecordPatSynField GhcRn -> LIdP GhcRn
    RecordPatSynField GhcRn -> GenLocated SrcSpanAnnN Name
    forall pass. RecordPatSynField pass -> LIdP pass
    recordPatSynPatVar [RecordPatSynField 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 -> XRec p [LMatch p body]
    mg_alts =
                               (L SrcSpanAnnL
    l [L SrcSpanAnnA
    loc match :: Match GhcRn (GenLocated SrcSpanAnnA (HsExpr 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 = L l [L loc (match { m_pats = nlWildPatName : pats })] }
        add_dummy_arg MatchGroup GhcRn (LHsExpr GhcRn)
    other_mg = String -> SDoc -> MatchGroup GhcRn (LHsExpr GhcRn)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "add_dummy_arg" (SDoc -> MatchGroup GhcRn (LHsExpr GhcRn))
    -> SDoc -> MatchGroup GhcRn (LHsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $
                                 MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    MatchGroup (GhcPass idR) body -> SDoc
    pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    other_mg

    patSynBuilderOcc :: PatSyn -> Maybe (HsExpr GhcTc, TcSigmaType)
    patSynBuilderOcc :: PatSyn -> Maybe (HsExpr GhcTc, Kind)
    patSynBuilderOcc PatSyn
    ps
      | Just (Name
    _, Kind
    builder_ty, Bool
    add_void_arg) <- PatSyn -> PatSynBuilder
    patSynBuilder PatSyn
    ps
      , let builder_expr :: HsExpr GhcTc
    builder_expr = ConLike -> HsExpr GhcTc
    mkConLikeTc (PatSyn -> ConLike
    PatSynCon PatSyn
    ps)
      = (HsExpr GhcTc, Kind) -> Maybe (HsExpr GhcTc, Kind)
    forall a. a -> Maybe a
    Just ((HsExpr GhcTc, Kind) -> Maybe (HsExpr GhcTc, Kind))
    -> (HsExpr GhcTc, Kind) -> Maybe (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
      = Maybe (HsExpr GhcTc, Kind)
    forall a. Maybe a
    Nothing

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

    tcPatToExpr :: [LocatedN Name] -> LPat GhcRn
                -> Either PatSynInvalidRhsReason (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 :: [GenLocated SrcSpanAnnN Name]
    -> LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    tcPatToExpr [GenLocated SrcSpanAnnN Name]
    args LPat GhcRn
    pat = LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    go LPat GhcRn
    pat
      where
        lhsVars :: NameSet
    lhsVars = [Name] -> NameSet
    mkNameSet ((GenLocated SrcSpanAnnN Name -> Name)
    -> [GenLocated SrcSpanAnnN Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnN Name -> Name
    forall l e. GenLocated l e -> e
    unLoc [GenLocated SrcSpanAnnN Name]
    args)

        -- Make a prefix con for prefix and infix patterns for simplicity
        mkPrefixConExpr :: LocatedN Name -> [LPat GhcRn]
                        -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
        mkPrefixConExpr :: GenLocated SrcSpanAnnN Name
    -> [LPat GhcRn] -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    mkPrefixConExpr lcon :: GenLocated SrcSpanAnnN Name
    lcon@(L SrcSpanAnnN
    loc Name
    _) [LPat GhcRn]
    pats
          = do { exprs <- (GenLocated SrcSpanAnnA (Pat GhcRn)
     -> Either
          PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> [GenLocated SrcSpanAnnA (Pat GhcRn)]
    -> Either
         PatSynInvalidRhsReason [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    GenLocated SrcSpanAnnA (Pat GhcRn)
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    go [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    pats
               ; let con = SrcSpanAnnA
    -> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall l e. l -> e -> GenLocated l e
    L (SrcSpanAnnN -> SrcSpanAnnA
    forall a b. (HasLoc a, HasAnnotation b) => a -> b
    l2l SrcSpanAnnN
    loc) (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
    forall p. XVar p -> LIdP p -> HsExpr p
    HsVar XVar GhcRn
    NoExtField
    noExtField LIdP GhcRn
    GenLocated SrcSpanAnnN Name
    lcon)
               ; return (unLoc $ mkHsApps con exprs)
               }

        mkRecordConExpr :: LocatedN Name -> HsRecFields GhcRn (LPat GhcRn)
                        -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
        mkRecordConExpr :: GenLocated SrcSpanAnnN Name
    -> HsRecFields GhcRn (LPat GhcRn)
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    mkRecordConExpr GenLocated SrcSpanAnnN Name
    con (HsRecFields [LHsRecField GhcRn (LPat GhcRn)]
    fields Maybe (XRec GhcRn RecFieldsDotDot)
    dd)
          = do { exprFields <- (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
          (GenLocated SrcSpanAnnA (Pat GhcRn)))
     -> Either
          PatSynInvalidRhsReason
          (GenLocated
             SrcSpanAnnA
             (HsFieldBind
                (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
                (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
    -> [GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
             (GenLocated SrcSpanAnnA (Pat GhcRn)))]
    -> Either
         PatSynInvalidRhsReason
         [GenLocated
            SrcSpanAnnA
            (HsFieldBind
               (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
               (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LHsRecField GhcRn (LPat GhcRn)
    -> Either
         PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn))
    GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (Pat GhcRn)))
    -> Either
         PatSynInvalidRhsReason
         (GenLocated
            SrcSpanAnnA
            (HsFieldBind
               (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
               (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    go' [LHsRecField GhcRn (LPat GhcRn)]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
          (GenLocated SrcSpanAnnA (Pat GhcRn)))]
    fields
               ; return (RecordCon noExtField con (HsRecFields exprFields dd)) }

        go' :: LHsRecField GhcRn (LPat GhcRn) -> Either PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn))
        go' :: LHsRecField GhcRn (LPat GhcRn)
    -> Either
         PatSynInvalidRhsReason (LHsRecField GhcRn (LHsExpr GhcRn))
    go' (L SrcSpanAnnA
    l HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (Pat GhcRn))
    rf) = SrcSpanAnnA
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (HsFieldBind
       (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
       (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
             (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    -> Either
         PatSynInvalidRhsReason
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> Either
         PatSynInvalidRhsReason
         (GenLocated
            SrcSpanAnnA
            (HsFieldBind
               (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
               (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GenLocated SrcSpanAnnA (Pat GhcRn)
     -> Either
          PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (Pat GhcRn))
    -> Either
         PatSynInvalidRhsReason
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
            (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) a
    -> f (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) b)
    traverse LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    GenLocated SrcSpanAnnA (Pat GhcRn)
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    go HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (Pat GhcRn))
    rf

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

        go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
        go1 :: Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    go1 (ConPat XConPat GhcRn
    NoExtField
    NoExtField XRec GhcRn (ConLikeP GhcRn)
    con HsConPatDetails GhcRn
    info)
          = case HsConPatDetails GhcRn
    info of
              PrefixCon [HsConPatTyArg (NoGhcTc GhcRn)]
    _ [LPat GhcRn]
    ps -> GenLocated SrcSpanAnnN Name
    -> [LPat GhcRn] -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    mkPrefixConExpr XRec GhcRn (ConLikeP GhcRn)
    GenLocated SrcSpanAnnN Name
    con [LPat GhcRn]
    ps
              InfixCon LPat GhcRn
    l LPat GhcRn
    r   -> GenLocated SrcSpanAnnN Name
    -> [LPat GhcRn] -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    mkPrefixConExpr XRec GhcRn (ConLikeP GhcRn)
    GenLocated SrcSpanAnnN Name
    con [LPat GhcRn
    l,LPat GhcRn
    r]
              RecCon HsRecFields GhcRn (LPat GhcRn)
    fields  -> GenLocated SrcSpanAnnN Name
    -> HsRecFields GhcRn (LPat GhcRn)
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    mkRecordConExpr XRec GhcRn (ConLikeP GhcRn)
    GenLocated SrcSpanAnnN Name
    con HsRecFields GhcRn (LPat GhcRn)
    fields

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

        go1 (VarPat XVarPat GhcRn
    _ (L SrcSpanAnnN
    l Name
    var))
            | Name
    var Name -> NameSet -> Bool
    `elemNameSet` NameSet
    lhsVars
            = HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. a -> Either PatSynInvalidRhsReason a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
    forall p. XVar p -> LIdP p -> HsExpr p
    HsVar XVar GhcRn
    NoExtField
    noExtField (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    l Name
    var)
            | Bool
    otherwise
            = PatSynInvalidRhsReason
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. a -> Either a b
    Left (Name -> PatSynInvalidRhsReason
    PatSynUnboundVar Name
    var)
        go1 (ParPat XParPat GhcRn
    _ LPat GhcRn
    pat) = (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b.
    (a -> b)
    -> Either PatSynInvalidRhsReason a
    -> Either PatSynInvalidRhsReason b
    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 XPar GhcRn
    NoExtField
    noExtField) (LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    go LPat GhcRn
    pat)
        go1 (ListPat XListPat GhcRn
    _ [LPat GhcRn]
    pats)
          = do { exprs <- (GenLocated SrcSpanAnnA (Pat GhcRn)
     -> Either
          PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> [GenLocated SrcSpanAnnA (Pat GhcRn)]
    -> Either
         PatSynInvalidRhsReason [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    GenLocated SrcSpanAnnA (Pat GhcRn)
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    go [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    pats
               ; return $ ExplicitList noExtField exprs }
        go1 (TuplePat XTuplePat GhcRn
    _ [LPat GhcRn]
    pats Boxity
    box)       = do { exprs <- (GenLocated SrcSpanAnnA (Pat GhcRn)
     -> Either
          PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> [GenLocated SrcSpanAnnA (Pat GhcRn)]
    -> Either
         PatSynInvalidRhsReason [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LPat GhcRn -> Either PatSynInvalidRhsReason (LHsExpr GhcRn)
    GenLocated SrcSpanAnnA (Pat GhcRn)
    -> Either
         PatSynInvalidRhsReason (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    go [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    pats
                                             ; return $ ExplicitTuple noExtField
                                               (map (Present noExtField) exprs) box }
        go1 (SumPat XSumPat GhcRn
    _ LPat GhcRn
    pat Int
    alt Int
    arity)    = do { expr <- Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    go1 (GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn
    forall l e. GenLocated l e -> e
    unLoc LPat GhcRn
    GenLocated SrcSpanAnnA (Pat GhcRn)
    pat)
                                             ; return $ ExplicitSum noExtField alt arity
                                                                       (noLocA expr)
                                             }
        go1 (LitPat XLitPat GhcRn
    _ HsLit GhcRn
    lit)              = HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. a -> Either PatSynInvalidRhsReason a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
    forall p. XLitE p -> HsLit p -> HsExpr p
    HsLit XLitE GhcRn
    NoExtField
    noExtField HsLit GhcRn
    lit
        go1 (NPat XNPat GhcRn
    _ (L EpAnnCO
    _ HsOverLit GhcRn
    n) Maybe (SyntaxExpr GhcRn)
    mb_neg SyntaxExpr GhcRn
    _)
            | Just (SyntaxExprRn HsExpr GhcRn
    neg) <- Maybe (SyntaxExpr GhcRn)
    mb_neg
                                        = HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. a -> Either PatSynInvalidRhsReason a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA (HsExpr GhcRn)
     -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
     -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA HsExpr GhcRn
    neg)
                                                           [HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcRn
    NoExtField
    noExtField HsOverLit GhcRn
    n)]
            | Bool
    otherwise                 = HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. a -> Either PatSynInvalidRhsReason a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcRn
    NoExtField
    noExtField HsOverLit GhcRn
    n
        go1 (SplicePat (HsUntypedSpliceTop ThModFinalizers
    _ Pat GhcRn
    pat) HsUntypedSplice GhcRn
    _) = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    go1 Pat GhcRn
    pat
        go1 (SplicePat (HsUntypedSpliceNested Name
    _) HsUntypedSplice GhcRn
    _)  = String -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. HasCallStack => String -> a
    panic String
    "tcPatToExpr: invalid nested splice"
        go1 (EmbTyPat XEmbTyPat GhcRn
    _ HsTyPat (NoGhcTc GhcRn)
    tp) = HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. a -> Either PatSynInvalidRhsReason a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn))
    -> HsExpr GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XEmbTy GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
    forall p. XEmbTy p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsEmbTy XEmbTy GhcRn
    NoExtField
    noExtField (HsTyPat GhcRn -> LHsWcType GhcRn
    hstp_to_hswc HsTyPat (NoGhcTc GhcRn)
    HsTyPat GhcRn
    tp)
          where hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn
                hstp_to_hswc :: HsTyPat GhcRn -> LHsWcType GhcRn
    hstp_to_hswc (HsTP { hstp_ext :: forall pass. HsTyPat pass -> XHsTP pass
    hstp_ext = HsTPRn { hstp_nwcs :: HsTyPatRn -> [Name]
    hstp_nwcs = [Name]
    wcs }, hstp_body :: forall pass. HsTyPat pass -> LHsType pass
    hstp_body = LHsType GhcRn
    hs_ty })
                            = HsWC { hswc_ext :: XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
    hswc_ext = [Name]
    XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
    wcs, hswc_body :: GenLocated SrcSpanAnnA (HsType GhcRn)
    hswc_body = LHsType GhcRn
    GenLocated SrcSpanAnnA (HsType GhcRn)
    hs_ty }
        go1 (InvisPat XInvisPat GhcRn
    _ HsTyPat (NoGhcTc GhcRn)
    _tp) = String -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a. HasCallStack => String -> a
    panic String
    "tcPatToExpr: invalid invisible pattern"
        go1 (XPat (HsPatExpanded Pat GhcRn
    _ Pat GhcRn
    pat))= Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    go1 Pat GhcRn
    pat

        -- See Note [Invertible view patterns]
        go1 p :: Pat GhcRn
    p@(ViewPat XViewPat GhcRn
    mbInverse LHsExpr GhcRn
    _ LPat GhcRn
    pat) = case XViewPat GhcRn
    mbInverse of
          Maybe (HsExpr GhcRn)
    XViewPat GhcRn
    Nothing      -> Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p
          Just HsExpr GhcRn
    inverse ->
            (HsExpr GhcRn -> HsExpr GhcRn)
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall a b.
    (a -> b)
    -> Either PatSynInvalidRhsReason a
    -> Either PatSynInvalidRhsReason b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
              (\ HsExpr GhcRn
    expr -> XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp XApp GhcRn
    NoExtField
    noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan HsExpr GhcRn
    inverse) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan HsExpr GhcRn
    expr))
              (Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    go1 (GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn
    forall l e. GenLocated l e -> e
    unLoc LPat GhcRn
    GenLocated SrcSpanAnnA (Pat GhcRn)
    pat))

        -- The following patterns are not invertible.
        go1 p :: Pat GhcRn
    p@(BangPat {})                       = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p -- #14112
        go1 p :: Pat GhcRn
    p@(LazyPat {})                       = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(WildPat {})                       = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(AsPat {})                         = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p
        go1 p :: Pat GhcRn
    p@(NPlusKPat {})                     = Pat GhcRn -> Either PatSynInvalidRhsReason (HsExpr GhcRn)
    forall {b}. Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p

        notInvertible :: Pat GhcRn -> Either PatSynInvalidRhsReason b
    notInvertible Pat GhcRn
    p = PatSynInvalidRhsReason -> Either PatSynInvalidRhsReason b
    forall a b. a -> Either a b
    Left (Pat GhcRn -> PatSynInvalidRhsReason
    PatSynNotInvertible Pat GhcRn
    p)

    {- Note [Builder for a bidirectional pattern synonym]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For a bidirectional pattern synonym, the function 'tcPatToExpr'
    needs 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. general view patterns
          pattern F x = (f -> x)
       as we don't have the ability to write down an expression that matches
       the view pattern specified by an arbitrary view function `f`.
       It is however sometimes possible to write down an inverse;
         see Note [Invertible view patterns].

     * 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 [Invertible view patterns]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For some view patterns, such as those that arise from expansion of overloaded
    patterns (as detailed in Note [Handling overloaded and rebindable patterns]),
    we are able to explicitly write out an inverse (in the sense of the previous
    Note [Builder for a bidirectional pattern synonym]).
    For instance, the inverse to the pattern

      (toList -> [True, False])

    is the expression

      (fromListN 2 [True,False])

    Keeping track of the inverse for such view patterns fixed #14380.

    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!

    Note [Pragmas for pattern synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    INLINE and NOINLINE pragmas are supported for pattern synonyms.
    They affect both the matcher and the builder.
    (See Note [Matchers and builders for pattern synonyms] in PatSyn)

    For example:
        pattern InlinedPattern x = [x]
        {-# INLINE InlinedPattern #-}

        pattern NonInlinedPattern x = [x]
        {-# NOINLINE NonInlinedPattern #-}

    For pattern synonyms with explicit builders, only a pragma for the
    entire pattern synonym is supported. For example:
        pattern HeadC x <- x:xs where
          HeadC x = [x]
          -- This wouldn't compile: {-# INLINE HeadC #-}
        {-# INLINE HeadC #-} -- But this works

    When no pragma is provided for a pattern, the inlining decision might change
    between different versions of GHC.

    Implementation notes.  The prag_fn passed in to tcPatSynDecl will have a binding
    for the /pattern synonym/ Name, thus
          InlinedPattern :-> INLINE
    From this we cook up an INLINE pragma for the matcher (in tcPatSynMatcher)
    and builder (in tcPatSynBuilderBind), by looking up the /pattern synonym/
    Name in the prag_fn, and then using addInlinePragArity to add the right
    inl_sat field to that INLINE pragma for the matcher or builder respectively.
     -}

    -- 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]))
    -> (GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc)
    -> GenLocated SrcSpanAnnA (Pat GhcTc)
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (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
    _ LIdP 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]))
    -> ([LPat GhcTc] -> [([Id], [Id])]) -> [LPat GhcTc] -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id]))
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map LPat GhcTc -> ([Id], [Id])
    GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id])
    go ([LPat GhcTc] -> ([Id], [Id])) -> [LPat GhcTc] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [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]))
    -> ([LPat GhcTc] -> [([Id], [Id])]) -> [LPat GhcTc] -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id]))
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map LPat GhcTc -> ([Id], [Id])
    GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id])
    go ([LPat GhcTc] -> ([Id], [Id])) -> [LPat GhcTc] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [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 XXPat GhcTc
    ext) = case XXPat GhcTc
    ext of
          CoPat HsWrapper
    _ Pat GhcTc
    p Kind
    _      -> Pat GhcTc -> ([Id], [Id])
    go1 Pat GhcTc
    p
          ExpansionPat Pat GhcRn
    _ Pat GhcTc
    p -> Pat GhcTc -> ([Id], [Id])
    go1 Pat GhcTc
    p
        go1 (NPlusKPat XNPlusKPat GhcTc
    _ LIdP GhcTc
    n XRec GhcTc (HsOverLit GhcTc)
    k HsOverLit GhcTc
    _ SyntaxExpr GhcTc
    geq SyntaxExpr GhcTc
    subtract)
          = String -> SDoc -> ([Id], [Id])
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "TODO: NPlusKPat" (SDoc -> ([Id], [Id])) -> SDoc -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnN Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LIdP GhcTc
    GenLocated SrcSpanAnnN Id
    n SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ GenLocated EpAnnCO (HsOverLit GhcTc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr XRec GhcTc (HsOverLit GhcTc)
    GenLocated EpAnnCO (HsOverLit GhcTc)
    k SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SyntaxExprTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SyntaxExpr GhcTc
    SyntaxExprTc
    geq SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SyntaxExprTc -> SDoc
    forall a. Outputable a => a -> SDoc
    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 [HsConPatTyArg (NoGhcTc GhcTc)]
    _ [LPat GhcTc]
    ps) = [([Id], [Id])] -> ([Id], [Id])
    forall {a} {a}. [([a], [a])] -> ([a], [a])
    mergeMany ([([Id], [Id])] -> ([Id], [Id]))
    -> ([LPat GhcTc] -> [([Id], [Id])]) -> [LPat GhcTc] -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id]))
    -> [GenLocated SrcSpanAnnA (Pat GhcTc)] -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map LPat GhcTc -> ([Id], [Id])
    GenLocated SrcSpanAnnA (Pat GhcTc) -> ([Id], [Id])
    go ([LPat GhcTc] -> ([Id], [Id])) -> [LPat GhcTc] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [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 (LPat GhcTc)] -> [([Id], [Id])])
    -> [LHsRecField GhcTc (LPat GhcTc)]
    -> ([Id], [Id])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
          (GenLocated SrcSpanAnnA (Pat GhcTc)))
     -> ([Id], [Id]))
    -> [GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
             (GenLocated SrcSpanAnnA (Pat GhcTc)))]
    -> [([Id], [Id])]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsRecField GhcTc (LPat GhcTc) -> ([Id], [Id])
    GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> ([Id], [Id])
    goRecFd ([LHsRecField GhcTc (LPat GhcTc)] -> ([Id], [Id]))
    -> [LHsRecField GhcTc (LPat GhcTc)] -> ([Id], [Id])
    forall a b. (a -> b) -> a -> b
    $ [LHsRecField GhcTc (LPat GhcTc)]
    flds

        goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([TyVar], [EvVar])
        goRecFd :: LHsRecField GhcTc (LPat GhcTc) -> ([Id], [Id])
    goRecFd (L SrcSpanAnnA
    _ HsFieldBind{ hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
    hfbRHS = GenLocated SrcSpanAnnA (Pat GhcTc)
    p }) = LPat GhcTc -> ([Id], [Id])
    go LPat GhcTc
    GenLocated SrcSpanAnnA (Pat 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 a b. (a -> b -> b) -> b -> [a] -> b
    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     = ([], [])