De-orphan a load of Binary instances
[ghc.git] / compiler / types / Class.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 The @Class@ datatype
7
8 \begin{code}
9 {-# OPTIONS -fno-warn-tabs #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and
12 -- detab the module (please do the detabbing in a separate patch). See
13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
14 -- for details
15
16 module Class (
17         Class,
18         ClassOpItem, DefMeth (..),
19         ClassATItem,
20         defMethSpecOfDefMeth,
21
22         FunDep, pprFundeps, pprFunDep,
23
24         mkClass, classTyVars, classArity, 
25         classKey, className, classATs, classATItems, classTyCon, classMethods,
26         classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
27         classAllSelIds, classSCSelId
28     ) where
29
30 #include "Typeable.h"
31 #include "HsVersions.h"
32
33 import {-# SOURCE #-} TyCon     ( TyCon, tyConName, tyConUnique )
34 import {-# SOURCE #-} TypeRep   ( PredType )
35 import CoAxiom
36 import Var
37 import Name
38 import BasicTypes
39 import Unique
40 import Util
41 import Outputable
42 import FastString
43
44 import Data.Typeable (Typeable)
45 import qualified Data.Data as Data
46 \end{code}
47
48 %************************************************************************
49 %*                                                                      *
50 \subsection[Class-basic]{@Class@: basic definition}
51 %*                                                                      *
52 %************************************************************************
53
54 A @Class@ corresponds to a Greek kappa in the static semantics:
55
56 \begin{code}
57 data Class
58   = Class {
59         classTyCon :: TyCon,    -- The data type constructor for
60                                 -- dictionaries of this class
61                                 -- See Note [ATyCon for classes] in TypeRep
62
63         className :: Name,              -- Just the cached name of the TyCon
64         classKey  :: Unique,            -- Cached unique of TyCon
65         
66         classTyVars  :: [TyVar],        -- The class kind and type variables;
67                                         -- identical to those of the TyCon
68
69         classFunDeps :: [FunDep TyVar], -- The functional dependencies
70
71         -- Superclasses: eg: (F a ~ b, F b ~ G a, Eq a, Show b)
72         -- We need value-level selectors for both the dictionary 
73         -- superclasses and the equality superclasses
74         classSCTheta :: [PredType],     -- Immediate superclasses, 
75         classSCSels  :: [Id],           -- Selector functions to extract the
76                                         --   superclasses from a 
77                                         --   dictionary of this class
78         -- Associated types
79         classATStuff :: [ClassATItem],  -- Associated type families
80
81         -- Class operations (methods, not superclasses)
82         classOpStuff :: [ClassOpItem]   -- Ordered by tag
83      }
84   deriving Typeable
85
86 type FunDep a = ([a],[a])  --  e.g. class C a b c | a b -> c, a c -> b where...
87                            --  Here fun-deps are [([a,b],[c]), ([a,c],[b])]
88
89 type ClassOpItem = (Id, DefMeth)
90         -- Selector function; contains unfolding
91         -- Default-method info
92
93 data DefMeth = NoDefMeth                -- No default method
94              | DefMeth Name             -- A polymorphic default method
95              | GenDefMeth Name          -- A generic default method
96              deriving Eq
97
98 type ClassATItem = (TyCon,           -- See Note [Associated type tyvar names]
99                     [CoAxBranch])    -- Default associated types from these templates 
100   -- We can have more than one default per type; see
101   -- Note [Associated type defaults] in TcTyClsDecls
102
103 -- | Convert a `DefMethSpec` to a `DefMeth`, which discards the name field in
104 --   the `DefMeth` constructor of the `DefMeth`.
105 defMethSpecOfDefMeth :: DefMeth -> DefMethSpec
106 defMethSpecOfDefMeth meth
107  = case meth of
108         NoDefMeth       -> NoDM
109         DefMeth _       -> VanillaDM
110         GenDefMeth _    -> GenericDM
111
112 \end{code}
113
114 The @mkClass@ function fills in the indirect superclasses.
115
116 \begin{code}
117 mkClass :: [TyVar]
118         -> [([TyVar], [TyVar])]
119         -> [PredType] -> [Id]
120         -> [ClassATItem]
121         -> [ClassOpItem]
122         -> TyCon
123         -> Class
124
125 mkClass tyvars fds super_classes superdict_sels at_stuff
126         op_stuff tycon
127   = Class {     classKey     = tyConUnique tycon, 
128                 className    = tyConName tycon,
129                 classTyVars  = tyvars,
130                 classFunDeps = fds,
131                 classSCTheta = super_classes,
132                 classSCSels  = superdict_sels,
133                 classATStuff = at_stuff,
134                 classOpStuff = op_stuff,
135                 classTyCon   = tycon }
136 \end{code}
137
138 Note [Associated type tyvar names]
139 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
140 The TyCon of an associated type should use the same variable names as its
141 parent class. Thus
142     class C a b where
143       type F b x a :: *
144 We make F use the same Name for 'a' as C does, and similary 'b'.
145
146 The only reason for this is when checking instances it's easier to match 
147 them up, to ensure they match.  Eg
148     instance C Int [d] where
149       type F [d] x Int = ....
150 we should make sure that the first and third args match the instance
151 header.
152
153 This is the reason we use the Name and TyVar from the parent declaration,
154 in both class and instance decls: just to make this check easier.
155
156
157 %************************************************************************
158 %*                                                                      *
159 \subsection[Class-selectors]{@Class@: simple selectors}
160 %*                                                                      *
161 %************************************************************************
162
163 The rest of these functions are just simple selectors.
164
165 \begin{code}
166 classArity :: Class -> Arity
167 classArity clas = length (classTyVars clas)
168         -- Could memoise this
169
170 classAllSelIds :: Class -> [Id]
171 -- Both superclass-dictionary and method selectors
172 classAllSelIds c@(Class {classSCSels = sc_sels})
173   = sc_sels ++ classMethods c
174
175 classSCSelId :: Class -> Int -> Id
176 -- Get the n'th superclass selector Id
177 -- where n is 0-indexed, and counts 
178 --    *all* superclasses including equalities
179 classSCSelId (Class { classSCSels = sc_sels }) n
180   = ASSERT( n >= 0 && n < length sc_sels )
181     sc_sels !! n
182
183 classMethods :: Class -> [Id]
184 classMethods (Class {classOpStuff = op_stuff})
185   = [op_sel | (op_sel, _) <- op_stuff]
186
187 classOpItems :: Class -> [ClassOpItem]
188 classOpItems = classOpStuff
189
190 classATs :: Class -> [TyCon]
191 classATs (Class { classATStuff = at_stuff })
192   = [tc | (tc, _) <- at_stuff]
193
194 classATItems :: Class -> [ClassATItem]
195 classATItems = classATStuff
196
197 classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
198 classTvsFds c
199   = (classTyVars c, classFunDeps c)
200
201 classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])
202 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta, 
203                     classSCSels = sc_sels, classOpStuff = op_stuff})
204   = (tyvars, sc_theta, sc_sels, op_stuff)
205
206 classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])
207 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
208                          classSCTheta = sc_theta, classSCSels = sc_sels,
209                          classATStuff = ats, classOpStuff = op_stuff})
210   = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
211 \end{code}
212
213
214 %************************************************************************
215 %*                                                                      *
216 \subsection[Class-instances]{Instance declarations for @Class@}
217 %*                                                                      *
218 %************************************************************************
219
220 We compare @Classes@ by their keys (which include @Uniques@).
221
222 \begin{code}
223 instance Eq Class where
224     c1 == c2 = classKey c1 == classKey c2
225     c1 /= c2 = classKey c1 /= classKey c2
226
227 instance Ord Class where
228     c1 <= c2 = classKey c1 <= classKey c2
229     c1 <  c2 = classKey c1 <  classKey c2
230     c1 >= c2 = classKey c1 >= classKey c2
231     c1 >  c2 = classKey c1 >  classKey c2
232     compare c1 c2 = classKey c1 `compare` classKey c2
233 \end{code}
234
235 \begin{code}
236 instance Uniquable Class where
237     getUnique c = classKey c
238
239 instance NamedThing Class where
240     getName clas = className clas
241
242 instance Outputable Class where
243     ppr c = ppr (getName c)
244
245 instance Outputable DefMeth where
246     ppr (DefMeth n)    =  ptext (sLit "Default method") <+> ppr n
247     ppr (GenDefMeth n) =  ptext (sLit "Generic default method") <+> ppr n
248     ppr NoDefMeth      =  empty   -- No default method
249
250 pprFundeps :: Outputable a => [FunDep a] -> SDoc
251 pprFundeps []  = empty
252 pprFundeps fds = hsep (ptext (sLit "|") : punctuate comma (map pprFunDep fds))
253
254 pprFunDep :: Outputable a => FunDep a -> SDoc
255 pprFunDep (us, vs) = hsep [interppSP us, ptext (sLit "->"), interppSP vs]
256
257 instance Data.Data Class where
258     -- don't traverse?
259     toConstr _   = abstractConstr "Class"
260     gunfold _ _  = error "gunfold"
261     dataTypeOf _ = mkNoRepType "Class"
262 \end{code}