Major patch to introduce TyConBinder
[ghc.git] / compiler / types / Class.hs
1 -- (c) The University of Glasgow 2006
2 -- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 --
4 -- The @Class@ datatype
5
6 {-# LANGUAGE CPP #-}
7
8 module Class (
9 Class,
10 ClassOpItem,
11 ClassATItem(..),
12 ClassMinimalDef,
13 DefMethInfo, pprDefMethInfo, defMethSpecOfDefMeth,
14
15 FunDep, pprFundeps, pprFunDep,
16
17 mkClass, classTyVars, classArity,
18 classKey, className, classATs, classATItems, classTyCon, classMethods,
19 classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
20 classAllSelIds, classSCSelId, classMinimalDef, classHasFds,
21 naturallyCoherentClass
22 ) where
23
24 #include "HsVersions.h"
25
26 import {-# SOURCE #-} TyCon ( TyCon )
27 import {-# SOURCE #-} TyCoRep ( Type, PredType, pprType )
28 import Var
29 import Name
30 import BasicTypes
31 import Unique
32 import Util
33 import SrcLoc
34 import PrelNames ( eqTyConKey, coercibleTyConKey, typeableClassKey,
35 heqTyConKey )
36 import Outputable
37 import BooleanFormula (BooleanFormula)
38
39 import qualified Data.Data as Data
40
41 {-
42 ************************************************************************
43 * *
44 \subsection[Class-basic]{@Class@: basic definition}
45 * *
46 ************************************************************************
47
48 A @Class@ corresponds to a Greek kappa in the static semantics:
49 -}
50
51 data Class
52 = Class {
53 classTyCon :: TyCon, -- The data type constructor for
54 -- dictionaries of this class
55 -- See Note [ATyCon for classes] in TyCoRep
56
57 className :: Name, -- Just the cached name of the TyCon
58 classKey :: Unique, -- Cached unique of TyCon
59
60 classTyVars :: [TyVar], -- The class kind and type variables;
61 -- identical to those of the TyCon
62
63 classFunDeps :: [FunDep TyVar], -- The functional dependencies
64
65 -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)
66 -- We need value-level selectors for both the dictionary
67 -- superclasses and the equality superclasses
68 classSCTheta :: [PredType], -- Immediate superclasses,
69 classSCSels :: [Id], -- Selector functions to extract the
70 -- superclasses from a
71 -- dictionary of this class
72 -- Associated types
73 classATStuff :: [ClassATItem], -- Associated type families
74
75 -- Class operations (methods, not superclasses)
76 classOpStuff :: [ClassOpItem], -- Ordered by tag
77
78 -- Minimal complete definition
79 classMinimalDef :: ClassMinimalDef
80 }
81
82 -- | e.g.
83 --
84 -- > class C a b c | a b -> c, a c -> b where...
85 --
86 -- Here fun-deps are [([a,b],[c]), ([a,c],[b])]
87 --
88 -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'',
89
90 -- For details on above see note [Api annotations] in ApiAnnotation
91 type FunDep a = ([a],[a])
92
93 type ClassOpItem = (Id, DefMethInfo)
94 -- Selector function; contains unfolding
95 -- Default-method info
96
97 type DefMethInfo = Maybe (Name, DefMethSpec Type)
98 -- Nothing No default method
99 -- Just ($dm, VanillaDM) A polymorphic default method, name $dm
100 -- Just ($gm, GenericDM ty) A generic default method, name $gm, type ty
101 -- The generic dm type is *not* quantified
102 -- over the class variables; ie has the
103 -- class vaiables free
104
105 data ClassATItem
106 = ATI TyCon -- See Note [Associated type tyvar names]
107 (Maybe (Type, SrcSpan))
108 -- Default associated type (if any) from this template
109 -- Note [Associated type defaults]
110
111 type ClassMinimalDef = BooleanFormula Name -- Required methods
112
113 -- | Convert a `DefMethInfo` to a `DefMethSpec`, which discards the name field in
114 -- the `DefMeth` constructor of the `DefMeth`.
115 defMethSpecOfDefMeth :: DefMethInfo -> Maybe (DefMethSpec Type)
116 defMethSpecOfDefMeth meth
117 = case meth of
118 Nothing -> Nothing
119 Just (_, spec) -> Just spec
120
121 {-
122 Note [Associated type defaults]
123 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
124 The following is an example of associated type defaults:
125 class C a where
126 data D a r
127
128 type F x a b :: *
129 type F p q r = (p,q)->r -- Default
130
131 Note that
132
133 * The TyCons for the associated types *share type variables* with the
134 class, so that we can tell which argument positions should be
135 instantiated in an instance decl. (The first for 'D', the second
136 for 'F'.)
137
138 * We can have default definitions only for *type* families,
139 not data families
140
141 * In the default decl, the "patterns" should all be type variables,
142 but (in the source language) they don't need to be the same as in
143 the 'type' decl signature or the class. It's more like a
144 free-standing 'type instance' declaration.
145
146 * HOWEVER, in the internal ClassATItem we rename the RHS to match the
147 tyConTyVars of the family TyCon. So in the example above we'd get
148 a ClassATItem of
149 ATI F ((x,a) -> b)
150 So the tyConTyVars of the family TyCon bind the free vars of
151 the default Type rhs
152
153 The @mkClass@ function fills in the indirect superclasses.
154
155 The SrcSpan is for the entire original declaration.
156 -}
157
158 mkClass :: Name -> [TyVar]
159 -> [([TyVar], [TyVar])]
160 -> [PredType] -> [Id]
161 -> [ClassATItem]
162 -> [ClassOpItem]
163 -> ClassMinimalDef
164 -> TyCon
165 -> Class
166
167 mkClass cls_name tyvars fds super_classes superdict_sels at_stuff
168 op_stuff mindef tycon
169 = Class { classKey = nameUnique cls_name,
170 className = cls_name,
171 -- NB: tyConName tycon = cls_name,
172 -- But it takes a module loop to assert it here
173 classTyVars = tyvars,
174 classFunDeps = fds,
175 classSCTheta = super_classes,
176 classSCSels = superdict_sels,
177 classATStuff = at_stuff,
178 classOpStuff = op_stuff,
179 classMinimalDef = mindef,
180 classTyCon = tycon }
181
182 {-
183 Note [Associated type tyvar names]
184 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
185 The TyCon of an associated type should use the same variable names as its
186 parent class. Thus
187 class C a b where
188 type F b x a :: *
189 We make F use the same Name for 'a' as C does, and similary 'b'.
190
191 The reason for this is when checking instances it's easier to match
192 them up, to ensure they match. Eg
193 instance C Int [d] where
194 type F [d] x Int = ....
195 we should make sure that the first and third args match the instance
196 header.
197
198 Having the same variables for class and tycon is also used in checkValidRoles
199 (in TcTyClsDecls) when checking a class's roles.
200
201
202 ************************************************************************
203 * *
204 \subsection[Class-selectors]{@Class@: simple selectors}
205 * *
206 ************************************************************************
207
208 The rest of these functions are just simple selectors.
209 -}
210
211 classArity :: Class -> Arity
212 classArity clas = length (classTyVars clas)
213 -- Could memoise this
214
215 classAllSelIds :: Class -> [Id]
216 -- Both superclass-dictionary and method selectors
217 classAllSelIds c@(Class {classSCSels = sc_sels})
218 = sc_sels ++ classMethods c
219
220 classSCSelId :: Class -> Int -> Id
221 -- Get the n'th superclass selector Id
222 -- where n is 0-indexed, and counts
223 -- *all* superclasses including equalities
224 classSCSelId (Class { classSCSels = sc_sels }) n
225 = ASSERT( n >= 0 && n < length sc_sels )
226 sc_sels !! n
227
228 classMethods :: Class -> [Id]
229 classMethods (Class {classOpStuff = op_stuff})
230 = [op_sel | (op_sel, _) <- op_stuff]
231
232 classOpItems :: Class -> [ClassOpItem]
233 classOpItems = classOpStuff
234
235 classATs :: Class -> [TyCon]
236 classATs (Class { classATStuff = at_stuff })
237 = [tc | ATI tc _ <- at_stuff]
238
239 classATItems :: Class -> [ClassATItem]
240 classATItems = classATStuff
241
242 classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
243 classTvsFds c = (classTyVars c, classFunDeps c)
244
245 classHasFds :: Class -> Bool
246 classHasFds (Class { classFunDeps = fds }) = not (null fds)
247
248 classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])
249 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
250 classSCSels = sc_sels, classOpStuff = op_stuff})
251 = (tyvars, sc_theta, sc_sels, op_stuff)
252
253 classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])
254 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
255 classSCTheta = sc_theta, classSCSels = sc_sels,
256 classATStuff = ats, classOpStuff = op_stuff})
257 = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
258
259 -- | If a class is "naturally coherent", then we needn't worry at all, in any
260 -- way, about overlapping/incoherent instances. Just solve the thing!
261 naturallyCoherentClass :: Class -> Bool
262 -- See also Note [The equality class story] in TysPrim.
263 naturallyCoherentClass cls
264 = cls `hasKey` heqTyConKey ||
265 cls `hasKey` eqTyConKey ||
266 cls `hasKey` coercibleTyConKey ||
267 cls `hasKey` typeableClassKey
268
269 {-
270 ************************************************************************
271 * *
272 \subsection[Class-instances]{Instance declarations for @Class@}
273 * *
274 ************************************************************************
275
276 We compare @Classes@ by their keys (which include @Uniques@).
277 -}
278
279 instance Eq Class where
280 c1 == c2 = classKey c1 == classKey c2
281 c1 /= c2 = classKey c1 /= classKey c2
282
283 instance Uniquable Class where
284 getUnique c = classKey c
285
286 instance NamedThing Class where
287 getName clas = className clas
288
289 instance Outputable Class where
290 ppr c = ppr (getName c)
291
292 pprDefMethInfo :: DefMethInfo -> SDoc
293 pprDefMethInfo Nothing = empty -- No default method
294 pprDefMethInfo (Just (n, VanillaDM)) = text "Default method" <+> ppr n
295 pprDefMethInfo (Just (n, GenericDM ty)) = text "Generic default method"
296 <+> ppr n <+> dcolon <+> pprType ty
297
298 pprFundeps :: Outputable a => [FunDep a] -> SDoc
299 pprFundeps [] = empty
300 pprFundeps fds = hsep (vbar : punctuate comma (map pprFunDep fds))
301
302 pprFunDep :: Outputable a => FunDep a -> SDoc
303 pprFunDep (us, vs) = hsep [interppSP us, arrow, interppSP vs]
304
305 instance Data.Data Class where
306 -- don't traverse?
307 toConstr _ = abstractConstr "Class"
308 gunfold _ _ = error "gunfold"
309 dataTypeOf _ = mkNoRepType "Class"