2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Class]{The @Class@ datatype}
7 #include "HsVersions.h"
10 GenClass(..), Class(..),
13 getClassKey, getClassOps, getClassSelIds,
14 getSuperDictSelId, getClassOpId, getDefaultMethodId,
15 getClassSig, getClassBigSig, getClassInstEnv,
18 derivableClassKeys, cCallishClassKeys,
19 isNumericClass, isStandardClass, isCcallishClass,
21 GenClassOp(..), ClassOp(..),
23 getClassOpTag, getClassOpString,
28 -- and to make the interface self-sufficient...
31 CHK_Ubiq() -- debugging consistency check
35 import TyCon ( TyCon )
36 import TyVar ( TyVar(..), GenTyVar )
37 import Usage ( GenUsage, Usage(..), UVar(..) )
39 import Maybes ( assocMaybe, Maybe )
41 import Unique -- Keys for built-in classes
42 import Outputable ( Outputable(..), NamedThing(..), ExportFlag )
43 import Pretty ( Pretty(..), PrettyRep )
44 import PprStyle ( PprStyle )
45 import SrcLoc ( SrcLoc )
49 %************************************************************************
51 \subsection[Class-basic]{@Class@: basic definition}
53 %************************************************************************
55 A @Class@ corresponds to a Greek kappa in the static semantics:
57 The parameterisation wrt tyvar and uvar is only necessary to
58 get appropriately general instances of Ord3 for GenType.
62 = ClassOp FAST_STRING -- The operation name
64 Int -- Unique within a class; starts at 1
66 ty -- Type; the class tyvar is free (you can find
67 -- it from the class). This means that a
68 -- ClassOp doesn't make much sense outside the
69 -- context of its parent class.
71 data GenClass tyvar uvar
73 Unique -- Key for fast comparison
76 tyvar -- The class type variable
78 [GenClass tyvar uvar] -- Immediate superclasses, and the
79 [Id] -- corresponding selector functions to
80 -- extract them from a dictionary of this
83 [GenClassOp (GenType tyvar uvar)] -- The * class operations
84 [Id] -- * selector functions
85 [Id] -- * default methods
86 -- They are all ordered by tag. The
87 -- selector ids are less innocent than they
88 -- look, because their IdInfos contains
89 -- suitable specialisation information. In
90 -- particular, constant methods are
91 -- instances of selectors at suitably simple
94 ClassInstEnv -- Gives details of all the instances of this class
96 [(GenClass tyvar uvar, [GenClass tyvar uvar])]
97 -- Indirect superclasses;
98 -- (k,[k1,...,kn]) means that
99 -- k is an immediate superclass of k1
100 -- k1 is an immediate superclass of k2
101 -- ... and kn is an immediate superclass
102 -- of this class. (This is all redundant
103 -- information, since it can be derived from
104 -- the superclass information above.)
106 type Class = GenClass TyVar UVar
107 type ClassOp = GenClassOp Type
109 type ClassInstEnv = MatchEnv Type Id -- The Ids are dfuns
112 The @mkClass@ function fills in the indirect superclasses.
115 mkClass :: Unique -> Name -> TyVar
117 -> [ClassOp] -> [Id] -> [Id]
121 mkClass uniq full_name tyvar super_classes superdict_sels
122 class_ops dict_sels defms class_insts
123 = Class uniq full_name tyvar
124 super_classes superdict_sels
125 class_ops dict_sels defms
129 trans_clos :: [(Class,[Class])]
130 trans_clos = transitiveClosure succ (==) [ (clas, []) | clas <- super_classes ]
132 succ (clas@(Class _ _ _ super_classes _ _ _ _ _ _), links)
133 = [(super, (clas:links)) | super <- super_classes]
136 %************************************************************************
138 \subsection[Class-selectors]{@Class@: simple selectors}
140 %************************************************************************
142 The rest of these functions are just simple selectors.
145 getClassKey (Class key _ _ _ _ _ _ _ _ _) = key
146 getClassOps (Class _ _ _ _ _ ops _ _ _ _) = ops
147 getClassSelIds (Class _ _ _ _ _ _ sels _ _ _) = sels
149 getClassOpId (Class _ _ _ _ _ ops op_ids _ _ _) op
150 = op_ids !! (getClassOpTag op - 1)
151 getDefaultMethodId (Class _ _ _ _ _ ops _ defm_ids _ _) op
152 = defm_ids !! (getClassOpTag op - 1)
153 getSuperDictSelId (Class _ _ _ scs scsel_ids _ _ _ _ _) super_clas
154 = assoc "getSuperDictSelId" (scs `zip` scsel_ids) super_clas
156 getClassSig :: GenClass t u -> (t, [GenClass t u], [GenClassOp (GenType t u)])
157 getClassSig (Class _ _ tyvar super_classes _ ops _ _ _ _)
158 = (tyvar, super_classes, ops)
160 getClassBigSig (Class _ _ tyvar super_classes sdsels ops sels defms _ _)
161 = (tyvar, super_classes, sdsels, ops, sels, defms)
163 getClassInstEnv (Class _ _ _ _ _ _ _ _ inst_env _) = inst_env
166 @a `isSuperClassOf` b@ returns @Nothing@ if @a@ is not a superclass of
167 @b@, but if it is, it returns $@Just@~[k_1,\ldots,k_n]$, where the
168 $k_1,\ldots,k_n$ are exactly as described in the definition of the
169 @GenClass@ constructor above.
172 isSuperClassOf :: Class -> Class -> Maybe [Class]
173 clas `isSuperClassOf` (Class _ _ _ _ _ _ _ _ _ links) = assocMaybe links clas
176 %************************************************************************
178 \subsection[Class-std-groups]{Standard groups of Prelude classes}
180 %************************************************************************
182 @derivableClassKeys@ is also used in checking \tr{deriving} constructs
185 NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
186 even though every numeric class has these two as a superclass,
187 because the list of ambiguous dictionaries hasn't been simplified.
190 isNumericClass, isStandardClass :: Class -> Bool
192 isNumericClass (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` numericClassKeys
193 isStandardClass (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` standardClassKeys
194 isCcallishClass (Class key _ _ _ _ _ _ _ _ _) = key `is_elem` cCallishClassKeys
195 is_elem = isIn "is_X_Class"
214 cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
217 = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
219 -- We have to have "_CCallable" and "_CReturnable" in the standard
220 -- classes, so that if you go...
222 -- _ccall_ foo ... 93{-numeric literal-} ...
224 -- ... it can do The Right Thing on the 93.
227 %************************************************************************
229 \subsection[Class-instances]{Instance declarations for @Class@}
231 %************************************************************************
233 We compare @Classes@ by their keys (which include @Uniques@).
236 instance Ord3 (GenClass tyvar uvar) where
237 cmp (Class k1 _ _ _ _ _ _ _ _ _) (Class k2 _ _ _ _ _ _ _ _ _)
240 instance Eq (GenClass tyvar uvar) where
241 (Class k1 _ _ _ _ _ _ _ _ _) == (Class k2 _ _ _ _ _ _ _ _ _) = k1 == k2
242 (Class k1 _ _ _ _ _ _ _ _ _) /= (Class k2 _ _ _ _ _ _ _ _ _) = k1 /= k2
244 instance Ord (GenClass tyvar uvar) where
245 (Class k1 _ _ _ _ _ _ _ _ _) <= (Class k2 _ _ _ _ _ _ _ _ _) = k1 <= k2
246 (Class k1 _ _ _ _ _ _ _ _ _) < (Class k2 _ _ _ _ _ _ _ _ _) = k1 < k2
247 (Class k1 _ _ _ _ _ _ _ _ _) >= (Class k2 _ _ _ _ _ _ _ _ _) = k1 >= k2
248 (Class k1 _ _ _ _ _ _ _ _ _) > (Class k2 _ _ _ _ _ _ _ _ _) = k1 > k2
249 _tagCmp a b = case cmp a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
253 instance Uniquable (GenClass tyvar uvar) where
254 uniqueOf (Class u _ _ _ _ _ _ _ _ _) = u
256 instance NamedThing (GenClass tyvar uvar) where
257 getName (Class _ n _ _ _ _ _ _ _ _) = n
261 %************************************************************************
263 \subsection[ClassOp-basic]{@ClassOp@: type and basic functions}
265 %************************************************************************
267 A @ClassOp@ represents a a class operation. From it and its parent
268 class we can construct the dictionary-selector @Id@ for the
269 operation/superclass dictionary, and the @Id@ for its default method.
270 It appears in a list inside the @Class@ object.
272 The type of a method in a @ClassOp@ object is its local type; that is,
273 without the overloading of the class itself. For example, in the
277 op :: Ord b => a -> b -> a
279 the type recorded for @op@ in the @ClassOp@ list of the @Class@ object is
282 @Ord@~\beta \Rightarrow
283 \alpha \rightarrow \beta \rightarrow alpha$
285 (where $\alpha$ is the class type variable recorded in the @Class@
286 object). Of course, the type of @op@ recorded in the GVE will be its
289 $\forall \alpha \forall \beta.~
290 @Foo@~\alpha \Rightarrow
291 ~@Ord@~\beta \Rightarrow \alpha
292 \rightarrow \beta \rightarrow alpha$
294 ******************************************************************
295 **** That is, the type variables of a class op selector
296 *** are all at the outer level.
297 ******************************************************************
300 mkClassOp :: FAST_STRING -> Int -> ty -> GenClassOp ty
301 mkClassOp name tag ty = ClassOp name tag ty
303 getClassOpTag :: GenClassOp ty -> Int
304 getClassOpTag (ClassOp _ tag _) = tag
306 getClassOpString :: GenClassOp ty -> FAST_STRING
307 getClassOpString (ClassOp str _ _) = str
309 getClassOpLocalType :: GenClassOp ty -> ty {-SigmaType-}
310 getClassOpLocalType (ClassOp _ _ ty) = ty
313 %************************************************************************
315 \subsection[ClassOp-instances]{Instance declarations for @ClassOp@}
317 %************************************************************************
319 @ClassOps@ are compared by their tags.
322 instance Eq (GenClassOp ty) where
323 (ClassOp _ i1 _) == (ClassOp _ i2 _) = i1 == i2
324 (ClassOp _ i1 _) /= (ClassOp _ i2 _) = i1 == i2
326 instance Ord (GenClassOp ty) where
327 (ClassOp _ i1 _) <= (ClassOp _ i2 _) = i1 <= i2
328 (ClassOp _ i1 _) < (ClassOp _ i2 _) = i1 < i2
329 (ClassOp _ i1 _) >= (ClassOp _ i2 _) = i1 >= i2
330 (ClassOp _ i1 _) > (ClassOp _ i2 _) = i1 > i2
331 -- ToDo: something for _tagCmp? (WDP 94/10)