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,
13 classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
17 #include "HsVersions.h"
19 import {-# SOURCE #-} TyCon ( TyCon )
20 import {-# SOURCE #-} TypeRep ( PredType )
22 import Var ( Id, TyVar )
23 import Name ( NamedThing(..), Name )
24 import BasicTypes ( Arity )
25 import Unique ( Unique, Uniquable(..) )
27 import Util ( notNull )
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 to
49 -- extract them from a dictionary of this
52 classOpStuff :: [ClassOpItem], -- Ordered by tag
54 classTyCon :: TyCon -- The data type constructor for dictionaries
57 type FunDep a = ([a],[a]) -- e.g. class C a b c | a b -> c, a c -> b where ...
58 -- Here fun-deps are [([a,b],[c]), ([a,c],[b])]
60 type ClassOpItem = (Id, DefMeth Name)
61 -- Selector function; contains unfolding
62 -- Default-method info
64 data DefMeth id = NoDefMeth -- No default method
65 | DefMeth id -- A polymorphic default method (named id)
66 -- (Only instantiated to RdrName and Name, never Id)
67 | GenDefMeth -- A generic default method
71 The @mkClass@ function fills in the indirect superclasses.
74 mkClass :: Name -> [TyVar]
75 -> [([TyVar], [TyVar])]
81 mkClass name tyvars fds super_classes superdict_sels
83 = Class { classKey = getUnique name,
87 classSCTheta = super_classes,
88 classSCSels = superdict_sels,
89 classOpStuff = op_stuff,
93 %************************************************************************
95 \subsection[Class-selectors]{@Class@: simple selectors}
97 %************************************************************************
99 The rest of these functions are just simple selectors.
102 classArity :: Class -> Arity
103 classArity clas = length (classTyVars clas)
104 -- Could memoise this
106 classSelIds (Class {classSCSels = sc_sels, classOpStuff = op_stuff})
107 = sc_sels ++ [op_sel | (op_sel, _) <- op_stuff]
110 = (classTyVars c, classFunDeps c)
112 classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta,
113 classSCSels = sc_sels, classOpStuff = op_stuff})
114 = (tyvars, sc_theta, sc_sels, op_stuff)
115 classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
116 classSCTheta = sc_theta, classSCSels = sc_sels,
117 classOpStuff = op_stuff})
118 = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
120 classHasFDs :: Class -> Bool
121 classHasFDs (Class {classFunDeps = fundeps}) = notNull fundeps
125 %************************************************************************
127 \subsection[Class-instances]{Instance declarations for @Class@}
129 %************************************************************************
131 We compare @Classes@ by their keys (which include @Uniques@).
134 instance Eq Class where
135 c1 == c2 = classKey c1 == classKey c2
136 c1 /= c2 = classKey c1 /= classKey c2
138 instance Ord Class where
139 c1 <= c2 = classKey c1 <= classKey c2
140 c1 < c2 = classKey c1 < classKey c2
141 c1 >= c2 = classKey c1 >= classKey c2
142 c1 > c2 = classKey c1 > classKey c2
143 compare c1 c2 = classKey c1 `compare` classKey c2
147 instance Uniquable Class where
148 getUnique c = classKey c
150 instance NamedThing Class where
151 getName clas = className clas
153 instance Outputable Class where
154 ppr c = ppr (getName c)
156 instance Show Class where
157 showsPrec p c = showsPrecSDoc p (ppr c)