2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Class]{The @Class@ datatype}
13 mkClass, classTyVars, classArity,
14 classKey, className, classATs, classSelIds, classTyCon, classMethods,
15 classBigSig, classExtraBigSig, classTvsFds, classSCTheta
18 #include "HsVersions.h"
20 import {-# SOURCE #-} TyCon ( TyCon )
21 import {-# SOURCE #-} TypeRep ( PredType )
23 import Var ( Id, TyVar )
24 import Name ( NamedThing(..), Name )
25 import BasicTypes ( Arity )
26 import Unique ( Unique, Uniquable(..) )
30 %************************************************************************
32 \subsection[Class-basic]{@Class@: basic definition}
34 %************************************************************************
36 A @Class@ corresponds to a Greek kappa in the static semantics:
41 classKey :: Unique, -- Key for fast comparison
44 classTyVars :: [TyVar], -- The class type variables
45 classFunDeps :: [FunDep TyVar], -- The functional dependencies
47 classSCTheta :: [PredType], -- Immediate superclasses, and the
48 classSCSels :: [Id], -- corresponding selector functions
49 -- to extract them from a dictionary
52 classATs :: [TyCon], -- Associated type families
54 classOpStuff :: [ClassOpItem], -- Ordered by tag
56 classTyCon :: TyCon -- The data type constructor for
57 -- dictionaries of this class
60 type FunDep a = ([a],[a]) -- e.g. class C a b c | a b -> c, a c -> b where...
61 -- Here fun-deps are [([a,b],[c]), ([a,c],[b])]
63 type ClassOpItem = (Id, DefMeth)
64 -- Selector function; contains unfolding
65 -- Default-method info
67 data DefMeth = NoDefMeth -- No default method
68 | DefMeth -- A polymorphic default method
69 | GenDefMeth -- A generic default method
73 The @mkClass@ function fills in the indirect superclasses.
76 mkClass :: Name -> [TyVar]
77 -> [([TyVar], [TyVar])]
84 mkClass name tyvars fds super_classes superdict_sels ats
86 = Class { classKey = getUnique name,
90 classSCTheta = super_classes,
91 classSCSels = superdict_sels,
93 classOpStuff = op_stuff,
97 %************************************************************************
99 \subsection[Class-selectors]{@Class@: simple selectors}
101 %************************************************************************
103 The rest of these functions are just simple selectors.
106 classArity :: Class -> Arity
107 classArity clas = length (classTyVars clas)
108 -- Could memoise this
110 classSelIds :: Class -> [Id]
111 classSelIds c@(Class {classSCSels = sc_sels})
112 = sc_sels ++ classMethods c
114 classMethods :: Class -> [Id]
115 classMethods (Class {classOpStuff = op_stuff})
116 = [op_sel | (op_sel, _) <- op_stuff]
119 = (classTyVars c, classFunDeps c)
121 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
122 classSCSels = sc_sels, classOpStuff = op_stuff})
123 = (tyvars, sc_theta, sc_sels, op_stuff)
124 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
125 classSCTheta = sc_theta, classSCSels = sc_sels,
126 classATs = ats, classOpStuff = op_stuff})
127 = (tyvars, fundeps, sc_theta, sc_sels, ats, op_stuff)
131 %************************************************************************
133 \subsection[Class-instances]{Instance declarations for @Class@}
135 %************************************************************************
137 We compare @Classes@ by their keys (which include @Uniques@).
140 instance Eq Class where
141 c1 == c2 = classKey c1 == classKey c2
142 c1 /= c2 = classKey c1 /= classKey c2
144 instance Ord Class where
145 c1 <= c2 = classKey c1 <= classKey c2
146 c1 < c2 = classKey c1 < classKey c2
147 c1 >= c2 = classKey c1 >= classKey c2
148 c1 > c2 = classKey c1 > classKey c2
149 compare c1 c2 = classKey c1 `compare` classKey c2
153 instance Uniquable Class where
154 getUnique c = classKey c
156 instance NamedThing Class where
157 getName clas = className clas
159 instance Outputable Class where
160 ppr c = ppr (getName c)
162 instance Show Class where
163 showsPrec p c = showsPrecSDoc p (ppr c)
165 instance Outputable DefMeth where
166 ppr DefMeth = text "{- has default method -}"
167 ppr GenDefMeth = text "{- has generic method -}"
168 ppr NoDefMeth = empty -- No default method
170 pprFundeps :: Outputable a => [FunDep a] -> SDoc
171 pprFundeps [] = empty
172 pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
174 ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"),