1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
{-# LANGUAGE TypeApplications #-}
-- | COMPLETE signature
module GHC.Types.CompleteMatch where
import GHC.Prelude
import GHC.Core.TyCo.Rep
import GHC.Types.Unique.DSet
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.Type ( splitTyConApp_maybe )
import GHC.Utils.Outputable
-- | A list of conlikes which represents a complete pattern match.
-- These arise from @COMPLETE@ signatures.
-- See also Note [Implementation of COMPLETE pragmas].
data CompleteMatch = CompleteMatch
{ cmConLikes :: UniqDSet ConLike -- ^ The set of `ConLike` values
, cmResultTyCon :: Maybe TyCon -- ^ The optional, concrete result TyCon the set applies to
}
vanillaCompleteMatch :: UniqDSet ConLike -> CompleteMatch
vanillaCompleteMatch cls = CompleteMatch { cmConLikes = cls, cmResultTyCon = Nothing }
instance Outputable CompleteMatch where
ppr (CompleteMatch cls mty) = case mty of
Nothing -> ppr cls
Just ty -> ppr cls <> text "@" <> parens (ppr ty)
type CompleteMatches = [CompleteMatch]
completeMatchAppliesAtType :: Type -> CompleteMatch -> Bool
completeMatchAppliesAtType ty cm = all @Maybe ty_matches (cmResultTyCon cm)
where
ty_matches sig_tc
| Just (tc, _arg_tys) <- splitTyConApp_maybe ty
, tc == sig_tc
|| sig_tc `is_family_ty_con_of` tc
-- #24326: sig_tc might be the data Family TyCon of the representation
-- TyCon tc -- this CompleteMatch still applies
= True
| otherwise
= False
fam_tc `is_family_ty_con_of` repr_tc =
(fst <$> tyConFamInst_maybe repr_tc) == Just fam_tc
|
