    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE UndecidableInstances #-}

    -- | COMPLETE signature
    module GHC.Types.CompleteMatch
      ( CompleteMatchX(..)
      , CompleteMatch, CompleteMatches
      , DsCompleteMatch, DsCompleteMatches
      , mkCompleteMatch, vanillaCompleteMatch
      , completeMatchAppliesAtType
      ) where

    import GHC.Prelude
    import GHC.Core.TyCo.Rep
    import GHC.Types.Unique
    import GHC.Core.ConLike
    import GHC.Core.TyCon
    import GHC.Core.Type ( splitTyConApp_maybe )
    import GHC.Types.Name ( Name )
    import GHC.Types.Unique.DSet
    import GHC.Utils.Outputable

    type CompleteMatch   = CompleteMatchX Name
    type DsCompleteMatch = CompleteMatchX ConLike

    type CompleteMatches   = [CompleteMatch]
    type DsCompleteMatches = [DsCompleteMatch]

    -- | A list of conlikes which represents a complete pattern match.
    -- These arise from @COMPLETE@ signatures.
    -- See also Note [Implementation of COMPLETE pragmas].
    data CompleteMatchX con = CompleteMatch
      { forall con. CompleteMatchX con -> UniqDSet con
    cmConLikes :: UniqDSet con  -- ^ The set of constructor names
      , forall con. CompleteMatchX con -> Maybe Name
    cmResultTyCon :: Maybe Name -- ^ The optional, concrete result TyCon name the set applies to
      }
      deriving CompleteMatchX con -> CompleteMatchX con -> Bool
    (CompleteMatchX con -> CompleteMatchX con -> Bool)
    -> (CompleteMatchX con -> CompleteMatchX con -> Bool)
    -> Eq (CompleteMatchX con)
    forall con. CompleteMatchX con -> CompleteMatchX con -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall con. CompleteMatchX con -> CompleteMatchX con -> Bool
    == :: CompleteMatchX con -> CompleteMatchX con -> Bool
    $c/= :: forall con. CompleteMatchX con -> CompleteMatchX con -> Bool
    /= :: CompleteMatchX con -> CompleteMatchX con -> Bool
    Eq

    mkCompleteMatch :: UniqDSet con -> Maybe Name -> CompleteMatchX con
    mkCompleteMatch :: forall con. UniqDSet con -> Maybe Name -> CompleteMatchX con
    mkCompleteMatch UniqDSet con
    nms Maybe Name
    mb_tc = CompleteMatch { cmConLikes :: UniqDSet con
    cmConLikes = UniqDSet con
    nms, cmResultTyCon :: Maybe Name
    cmResultTyCon = Maybe Name
    mb_tc }

    vanillaCompleteMatch :: UniqDSet con -> CompleteMatchX con
    vanillaCompleteMatch :: forall con. UniqDSet con -> CompleteMatchX con
    vanillaCompleteMatch UniqDSet con
    nms = UniqDSet con -> Maybe Name -> CompleteMatchX con
    forall con. UniqDSet con -> Maybe Name -> CompleteMatchX con
    mkCompleteMatch UniqDSet con
    nms Maybe Name
    forall a. Maybe a
    Nothing

    instance Outputable con => Outputable (CompleteMatchX con) where
      ppr :: CompleteMatchX con -> SDoc
    ppr (CompleteMatch UniqDSet con
    cls Maybe Name
    mty) = case Maybe Name
    mty of
        Maybe Name
    Nothing -> UniqDSet con -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UniqDSet con
    cls
        Just Name
    ty -> UniqDSet con -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UniqDSet con
    cls SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "@" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    parens (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    ty)

    -- | Does this 'COMPLETE' set apply at this type?
    --
    -- See the part about "result type constructors" in
    -- Note [Implementation of COMPLETE pragmas] in GHC.HsToCore.Pmc.Solver.
    completeMatchAppliesAtType :: Type -> CompleteMatchX con -> Bool
    completeMatchAppliesAtType :: forall con. Type -> CompleteMatchX con -> Bool
    completeMatchAppliesAtType Type
    ty CompleteMatchX con
    cm = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all @Maybe Unique -> Bool
    ty_matches (Name -> Unique
    forall a. Uniquable a => a -> Unique
    getUnique (Name -> Unique) -> Maybe Name -> Maybe Unique
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CompleteMatchX con -> Maybe Name
    forall con. CompleteMatchX con -> Maybe Name
    cmResultTyCon CompleteMatchX con
    cm)
      where
        ty_matches :: Unique -> Bool
        ty_matches :: Unique -> Bool
    ty_matches Unique
    sig_tc
          | Just (TyCon
    tc, [Type]
    _arg_tys) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
          , TyCon
    tc TyCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    sig_tc
          Bool -> Bool -> Bool
    || Unique
    sig_tc Unique -> TyCon -> Bool
    `is_family_ty_con_of` TyCon
    tc
             -- #24326: sig_tc might be the data Family TyCon of the representation
             --         TyCon tc -- this CompleteMatch still applies
          = Bool
    True
          | Bool
    otherwise
          = Bool
    False
        Unique
    fam_tc is_family_ty_con_of :: Unique -> TyCon -> Bool
    `is_family_ty_con_of` TyCon
    repr_tc =
          case (TyCon, [Type]) -> TyCon
    forall a b. (a, b) -> a
    fst ((TyCon, [Type]) -> TyCon) -> Maybe (TyCon, [Type]) -> Maybe TyCon
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TyCon -> Maybe (TyCon, [Type])
    tyConFamInst_maybe TyCon
    repr_tc of
            Just TyCon
    tc -> TyCon
    tc TyCon -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    fam_tc
            Maybe TyCon
    Nothing -> Bool
    False