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 )
40 --import Name ( Name )
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"
215 cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
218 = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
220 -- We have to have "CCallable" and "CReturnable" in the standard
221 -- classes, so that if you go...
223 -- _ccall_ foo ... 93{-numeric literal-} ...
225 -- ... it can do The Right Thing on the 93.
228 %************************************************************************
230 \subsection[Class-instances]{Instance declarations for @Class@}
232 %************************************************************************
234 We compare @Classes@ by their keys (which include @Uniques@).
237 instance Ord3 (GenClass tyvar uvar) where
238 cmp (Class k1 _ _ _ _ _ _ _ _ _) (Class k2 _ _ _ _ _ _ _ _ _)
241 instance Eq (GenClass tyvar uvar) where
242 (Class k1 _ _ _ _ _ _ _ _ _) == (Class k2 _ _ _ _ _ _ _ _ _) = k1 == k2
243 (Class k1 _ _ _ _ _ _ _ _ _) /= (Class k2 _ _ _ _ _ _ _ _ _) = k1 /= k2
245 instance Ord (GenClass tyvar uvar) where
246 (Class k1 _ _ _ _ _ _ _ _ _) <= (Class k2 _ _ _ _ _ _ _ _ _) = k1 <= k2
247 (Class k1 _ _ _ _ _ _ _ _ _) < (Class k2 _ _ _ _ _ _ _ _ _) = k1 < k2
248 (Class k1 _ _ _ _ _ _ _ _ _) >= (Class k2 _ _ _ _ _ _ _ _ _) = k1 >= k2
249 (Class k1 _ _ _ _ _ _ _ _ _) > (Class k2 _ _ _ _ _ _ _ _ _) = k1 > k2
250 _tagCmp a b = case cmp a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
254 instance Uniquable (GenClass tyvar uvar) where
255 uniqueOf (Class u _ _ _ _ _ _ _ _ _) = u
257 instance NamedThing (GenClass tyvar uvar) where
258 getName (Class _ n _ _ _ _ _ _ _ _) = n
262 %************************************************************************
264 \subsection[ClassOp-basic]{@ClassOp@: type and basic functions}
266 %************************************************************************
268 A @ClassOp@ represents a a class operation. From it and its parent
269 class we can construct the dictionary-selector @Id@ for the
270 operation/superclass dictionary, and the @Id@ for its default method.
271 It appears in a list inside the @Class@ object.
273 The type of a method in a @ClassOp@ object is its local type; that is,
274 without the overloading of the class itself. For example, in the
278 op :: Ord b => a -> b -> a
280 the type recorded for @op@ in the @ClassOp@ list of the @Class@ object is
283 @Ord@~\beta \Rightarrow
284 \alpha \rightarrow \beta \rightarrow alpha$
286 (where $\alpha$ is the class type variable recorded in the @Class@
287 object). Of course, the type of @op@ recorded in the GVE will be its
290 $\forall \alpha \forall \beta.~
291 @Foo@~\alpha \Rightarrow
292 ~@Ord@~\beta \Rightarrow \alpha
293 \rightarrow \beta \rightarrow alpha$
295 ******************************************************************
296 **** That is, the type variables of a class op selector
297 *** are all at the outer level.
298 ******************************************************************
301 mkClassOp :: FAST_STRING -> Int -> ty -> GenClassOp ty
302 mkClassOp name tag ty = ClassOp name tag ty
304 getClassOpTag :: GenClassOp ty -> Int
305 getClassOpTag (ClassOp _ tag _) = tag
307 getClassOpString :: GenClassOp ty -> FAST_STRING
308 getClassOpString (ClassOp str _ _) = str
310 getClassOpLocalType :: GenClassOp ty -> ty {-SigmaType-}
311 getClassOpLocalType (ClassOp _ _ ty) = ty
314 %************************************************************************
316 \subsection[ClassOp-instances]{Instance declarations for @ClassOp@}
318 %************************************************************************
320 @ClassOps@ are compared by their tags.
323 instance Eq (GenClassOp ty) where
324 (ClassOp _ i1 _) == (ClassOp _ i2 _) = i1 == i2
325 (ClassOp _ i1 _) /= (ClassOp _ i2 _) = i1 == i2
327 instance Ord (GenClassOp ty) where
328 (ClassOp _ i1 _) <= (ClassOp _ i2 _) = i1 <= i2
329 (ClassOp _ i1 _) < (ClassOp _ i2 _) = i1 < i2
330 (ClassOp _ i1 _) >= (ClassOp _ i2 _) = i1 >= i2
331 (ClassOp _ i1 _) > (ClassOp _ i2 _) = i1 > i2
332 -- ToDo: something for _tagCmp? (WDP 94/10)