2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Class]{The @Class@ datatype}
8 Class, ClassOpItem, FunDep,
11 mkClass, classTyVars, classArity,
12 classKey, className, classSelIds, classTyCon, classMethods,
13 classBigSig, classExtraBigSig, classTvsFds, classSCTheta
16 #include "HsVersions.h"
18 import {-# SOURCE #-} TyCon ( TyCon )
19 import {-# SOURCE #-} TypeRep ( PredType )
21 import Var ( Id, TyVar )
22 import Name ( NamedThing(..), Name )
23 import BasicTypes ( Arity )
24 import Unique ( Unique, Uniquable(..) )
28 %************************************************************************
30 \subsection[Class-basic]{@Class@: basic definition}
32 %************************************************************************
34 A @Class@ corresponds to a Greek kappa in the static semantics:
39 classKey :: Unique, -- Key for fast comparison
42 classTyVars :: [TyVar], -- The class type variables
43 classFunDeps :: [FunDep TyVar], -- The functional dependencies
45 classSCTheta :: [PredType], -- Immediate superclasses, and the
46 classSCSels :: [Id], -- corresponding selector functions to
47 -- extract them from a dictionary of this
50 classOpStuff :: [ClassOpItem], -- Ordered by tag
52 classTyCon :: TyCon -- The data type constructor for dictionaries
55 type FunDep a = ([a],[a]) -- e.g. class C a b c | a b -> c, a c -> b where ...
56 -- Here fun-deps are [([a,b],[c]), ([a,c],[b])]
58 type ClassOpItem = (Id, DefMeth)
59 -- Selector function; contains unfolding
60 -- Default-method info
62 data DefMeth = NoDefMeth -- No default method
63 | DefMeth -- A polymorphic default method
64 | GenDefMeth -- A generic default method
68 The @mkClass@ function fills in the indirect superclasses.
71 mkClass :: Name -> [TyVar]
72 -> [([TyVar], [TyVar])]
78 mkClass name tyvars fds super_classes superdict_sels
80 = Class { classKey = getUnique name,
84 classSCTheta = super_classes,
85 classSCSels = superdict_sels,
86 classOpStuff = op_stuff,
90 %************************************************************************
92 \subsection[Class-selectors]{@Class@: simple selectors}
94 %************************************************************************
96 The rest of these functions are just simple selectors.
99 classArity :: Class -> Arity
100 classArity clas = length (classTyVars clas)
101 -- Could memoise this
103 classSelIds :: Class -> [Id]
104 classSelIds c@(Class {classSCSels = sc_sels})
105 = sc_sels ++ classMethods c
107 classMethods :: Class -> [Id]
108 classMethods (Class {classOpStuff = op_stuff})
109 = [op_sel | (op_sel, _) <- op_stuff]
112 = (classTyVars c, classFunDeps c)
114 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
115 classSCSels = sc_sels, classOpStuff = op_stuff})
116 = (tyvars, sc_theta, sc_sels, op_stuff)
117 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
118 classSCTheta = sc_theta, classSCSels = sc_sels,
119 classOpStuff = op_stuff})
120 = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
124 %************************************************************************
126 \subsection[Class-instances]{Instance declarations for @Class@}
128 %************************************************************************
130 We compare @Classes@ by their keys (which include @Uniques@).
133 instance Eq Class where
134 c1 == c2 = classKey c1 == classKey c2
135 c1 /= c2 = classKey c1 /= classKey c2
137 instance Ord Class where
138 c1 <= c2 = classKey c1 <= classKey c2
139 c1 < c2 = classKey c1 < classKey c2
140 c1 >= c2 = classKey c1 >= classKey c2
141 c1 > c2 = classKey c1 > classKey c2
142 compare c1 c2 = classKey c1 `compare` classKey c2
146 instance Uniquable Class where
147 getUnique c = classKey c
149 instance NamedThing Class where
150 getName clas = className clas
152 instance Outputable Class where
153 ppr c = ppr (getName c)
155 instance Show Class where
156 showsPrec p c = showsPrecSDoc p (ppr c)
158 instance Outputable DefMeth where
159 ppr DefMeth = text "{- has default method -}"
160 ppr GenDefMeth = text "{- has generic method -}"
161 ppr NoDefMeth = empty -- No default method