never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1998
4
5 \section[ConLike]{@ConLike@: Constructor-like things}
6 -}
7
8
9
10 module GHC.Core.ConLike (
11 ConLike(..)
12 , isVanillaConLike
13 , conLikeArity
14 , conLikeFieldLabels
15 , conLikeInstOrigArgTys
16 , conLikeUserTyVarBinders
17 , conLikeExTyCoVars
18 , conLikeName
19 , conLikeStupidTheta
20 , conLikeImplBangs
21 , conLikeFullSig
22 , conLikeResTy
23 , conLikeFieldType
24 , conLikesWithFields
25 , conLikeIsInfix
26 , conLikeHasBuilder
27 ) where
28
29 import GHC.Prelude
30
31 import GHC.Core.DataCon
32 import GHC.Core.PatSyn
33 import GHC.Utils.Outputable
34 import GHC.Types.Unique
35 import GHC.Utils.Misc
36 import GHC.Types.Name
37 import GHC.Types.Basic
38 import GHC.Core.TyCo.Rep (Type, ThetaType)
39 import GHC.Types.Var
40 import GHC.Core.Type(mkTyConApp)
41 import GHC.Core.Multiplicity
42
43 import Data.Maybe( isJust )
44 import qualified Data.Data as Data
45
46 {-
47 ************************************************************************
48 * *
49 \subsection{Constructor-like things}
50 * *
51 ************************************************************************
52 -}
53
54 -- | A constructor-like thing
55 data ConLike = RealDataCon DataCon
56 | PatSynCon PatSyn
57
58 -- | Is this a \'vanilla\' constructor-like thing
59 -- (no existentials, no provided constraints)?
60 isVanillaConLike :: ConLike -> Bool
61 isVanillaConLike (RealDataCon con) = isVanillaDataCon con
62 isVanillaConLike (PatSynCon ps ) = isVanillaPatSyn ps
63
64 {-
65 ************************************************************************
66 * *
67 \subsection{Instances}
68 * *
69 ************************************************************************
70 -}
71
72 instance Eq ConLike where
73 (==) = eqConLike
74
75 eqConLike :: ConLike -> ConLike -> Bool
76 eqConLike x y = getUnique x == getUnique y
77
78 -- There used to be an Ord ConLike instance here that used Unique for ordering.
79 -- It was intentionally removed to prevent determinism problems.
80 -- See Note [Unique Determinism] in GHC.Types.Unique.
81
82 instance Uniquable ConLike where
83 getUnique (RealDataCon dc) = getUnique dc
84 getUnique (PatSynCon ps) = getUnique ps
85
86 instance NamedThing ConLike where
87 getName (RealDataCon dc) = getName dc
88 getName (PatSynCon ps) = getName ps
89
90 instance Outputable ConLike where
91 ppr (RealDataCon dc) = ppr dc
92 ppr (PatSynCon ps) = ppr ps
93
94 instance OutputableBndr ConLike where
95 pprInfixOcc (RealDataCon dc) = pprInfixOcc dc
96 pprInfixOcc (PatSynCon ps) = pprInfixOcc ps
97 pprPrefixOcc (RealDataCon dc) = pprPrefixOcc dc
98 pprPrefixOcc (PatSynCon ps) = pprPrefixOcc ps
99
100 instance Data.Data ConLike where
101 -- don't traverse?
102 toConstr _ = abstractConstr "ConLike"
103 gunfold _ _ = error "gunfold"
104 dataTypeOf _ = mkNoRepType "ConLike"
105
106 -- | Number of arguments
107 conLikeArity :: ConLike -> Arity
108 conLikeArity (RealDataCon data_con) = dataConSourceArity data_con
109 conLikeArity (PatSynCon pat_syn) = patSynArity pat_syn
110
111 -- | Names of fields used for selectors
112 conLikeFieldLabels :: ConLike -> [FieldLabel]
113 conLikeFieldLabels (RealDataCon data_con) = dataConFieldLabels data_con
114 conLikeFieldLabels (PatSynCon pat_syn) = patSynFieldLabels pat_syn
115
116 -- | Returns just the instantiated /value/ argument types of a 'ConLike',
117 -- (excluding dictionary args)
118 conLikeInstOrigArgTys :: ConLike -> [Type] -> [Scaled Type]
119 conLikeInstOrigArgTys (RealDataCon data_con) tys =
120 dataConInstOrigArgTys data_con tys
121 conLikeInstOrigArgTys (PatSynCon pat_syn) tys =
122 map unrestricted $ patSynInstArgTys pat_syn tys
123
124 -- | 'TyVarBinder's for the type variables of the 'ConLike'. For pattern
125 -- synonyms, this will always consist of the universally quantified variables
126 -- followed by the existentially quantified type variables. For data
127 -- constructors, the situation is slightly more complicated—see
128 -- @Note [DataCon user type variable binders]@ in "GHC.Core.DataCon".
129 conLikeUserTyVarBinders :: ConLike -> [InvisTVBinder]
130 conLikeUserTyVarBinders (RealDataCon data_con) =
131 dataConUserTyVarBinders data_con
132 conLikeUserTyVarBinders (PatSynCon pat_syn) =
133 patSynUnivTyVarBinders pat_syn ++ patSynExTyVarBinders pat_syn
134 -- The order here is because of the order in `GHC.Tc.TyCl.PatSyn`.
135
136 -- | Existentially quantified type/coercion variables
137 conLikeExTyCoVars :: ConLike -> [TyCoVar]
138 conLikeExTyCoVars (RealDataCon dcon1) = dataConExTyCoVars dcon1
139 conLikeExTyCoVars (PatSynCon psyn1) = patSynExTyVars psyn1
140
141 conLikeName :: ConLike -> Name
142 conLikeName (RealDataCon data_con) = dataConName data_con
143 conLikeName (PatSynCon pat_syn) = patSynName pat_syn
144
145 -- | The \"stupid theta\" of the 'ConLike', such as @data Eq a@ in:
146 --
147 -- > data Eq a => T a = ...
148 -- It is empty for `PatSynCon` as they do not allow such contexts.
149 conLikeStupidTheta :: ConLike -> ThetaType
150 conLikeStupidTheta (RealDataCon data_con) = dataConStupidTheta data_con
151 conLikeStupidTheta (PatSynCon {}) = []
152
153 -- | 'conLikeHasBuilder' returns True except for
154 -- uni-directional pattern synonyms, which have no builder
155 conLikeHasBuilder :: ConLike -> Bool
156 conLikeHasBuilder (RealDataCon {}) = True
157 conLikeHasBuilder (PatSynCon pat_syn) = isJust (patSynBuilder pat_syn)
158
159 -- | Returns the strictness information for each constructor
160 conLikeImplBangs :: ConLike -> [HsImplBang]
161 conLikeImplBangs (RealDataCon data_con) = dataConImplBangs data_con
162 conLikeImplBangs (PatSynCon pat_syn) =
163 replicate (patSynArity pat_syn) HsLazy
164
165 -- | Returns the type of the whole pattern
166 conLikeResTy :: ConLike -> [Type] -> Type
167 conLikeResTy (RealDataCon con) tys = mkTyConApp (dataConTyCon con) tys
168 conLikeResTy (PatSynCon ps) tys = patSynInstResTy ps tys
169
170 -- | The \"full signature\" of the 'ConLike' returns, in order:
171 --
172 -- 1) The universally quantified type variables
173 --
174 -- 2) The existentially quantified type/coercion variables
175 --
176 -- 3) The equality specification
177 --
178 -- 4) The provided theta (the constraints provided by a match)
179 --
180 -- 5) The required theta (the constraints required for a match)
181 --
182 -- 6) The original argument types (i.e. before
183 -- any change of the representation of the type)
184 --
185 -- 7) The original result type
186 conLikeFullSig :: ConLike
187 -> ([TyVar], [TyCoVar], [EqSpec]
188 -- Why tyvars for universal but tycovars for existential?
189 -- See Note [Existential coercion variables] in GHC.Core.DataCon
190 , ThetaType, ThetaType, [Scaled Type], Type)
191 conLikeFullSig (RealDataCon con) =
192 let (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) = dataConFullSig con
193 -- Required theta is empty as normal data cons require no additional
194 -- constraints for a match
195 in (univ_tvs, ex_tvs, eq_spec, theta, [], arg_tys, res_ty)
196 conLikeFullSig (PatSynCon pat_syn) =
197 let (univ_tvs, req, ex_tvs, prov, arg_tys, res_ty) = patSynSig pat_syn
198 -- eqSpec is empty
199 in (univ_tvs, ex_tvs, [], prov, req, arg_tys, res_ty)
200
201 -- | Extract the type for any given labelled field of the 'ConLike'
202 conLikeFieldType :: ConLike -> FieldLabelString -> Type
203 conLikeFieldType (PatSynCon ps) label = patSynFieldType ps label
204 conLikeFieldType (RealDataCon dc) label = dataConFieldType dc label
205
206
207 -- | The ConLikes that have *all* the given fields
208 conLikesWithFields :: [ConLike] -> [FieldLabelString] -> [ConLike]
209 conLikesWithFields con_likes lbls = filter has_flds con_likes
210 where has_flds dc = all (has_fld dc) lbls
211 has_fld dc lbl = any (\ fl -> flLabel fl == lbl) (conLikeFieldLabels dc)
212
213 conLikeIsInfix :: ConLike -> Bool
214 conLikeIsInfix (RealDataCon dc) = dataConIsInfix dc
215 conLikeIsInfix (PatSynCon ps) = patSynIsInfix ps