2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TyCon]{The @TyCon@ datatype}
8 TyCon, KindCon, SuperKindCon, ArgVrcs, AlgTyConFlavour(..),
10 isFunTyCon, isUnLiftedTyCon, isBoxedTyCon, isProductTyCon,
11 isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
12 isEnumerationTyCon, isTupleTyCon, isUnboxedTupleTyCon,
13 isRecursiveTyCon, newTyConRep,
44 #include "HsVersions.h"
46 import {-# SOURCE #-} TypeRep ( Type, Kind, SuperKind )
47 -- Should just be Type(Type), but this fails due to bug present up to
48 -- and including 4.02 involving slurping of hi-boot files. Bug is now fixed.
50 import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon )
52 import Class ( Class )
54 import BasicTypes ( Arity, NewOrData(..), RecFlag(..) )
56 import Name ( Name, nameUnique, NamedThing(getName) )
57 import Unique ( Unique, Uniquable(..), anyBoxConKey )
58 import PrimRep ( PrimRep(..), isFollowableRep )
62 %************************************************************************
64 \subsection{The data type}
66 %************************************************************************
70 type SuperKindCon = TyCon
74 tyConUnique :: Unique,
81 | AlgTyCon { -- Tuples, data type, and newtype decls.
82 -- All lifted, all boxed
83 tyConUnique :: Unique,
88 tyConTyVars :: [TyVar],
89 tyConArgVrcs :: ArgVrcs,
90 algTyConTheta :: [(Class,[Type])],
92 dataCons :: [DataCon],
93 -- Its data constructors, with fully polymorphic types
94 -- This list can be empty, when we import a data type abstractly,
95 -- either (a) the interface is hand-written and doesn't give
96 -- the constructors, or
97 -- (b) in a quest for fast compilation we don't import
100 algTyConDerivings :: [Class], -- Classes which have derived instances
102 algTyConFlavour :: AlgTyConFlavour,
103 algTyConRec :: RecFlag, -- Tells whether the data type is part of
104 -- a mutually-recursive group or not
106 algTyConClass_maybe :: Maybe Class -- Nothing for ordinary types;
107 -- Just c for the type constructor
108 -- for dictionaries of class c.
112 | PrimTyCon { -- Primitive types; cannot be defined in Haskell
113 -- NB: All of these guys are *unlifted*, but not all are *unboxed*
114 tyConUnique :: Unique,
118 tyConArgVrcs :: ArgVrcs,
119 primTyConRep :: PrimRep
124 tyConUnique :: Unique,
128 tyConBoxed :: Bool, -- True for boxed; False for unboxed
129 tyConTyVars :: [TyVar],
134 tyConUnique :: Unique,
139 tyConTyVars :: [TyVar], -- Bound tyvars
140 synTyConDefn :: Type, -- Right-hand side, mentioning these type vars.
141 -- Acts as a template for the expansion when
142 -- the tycon is applied to some types.
143 tyConArgVrcs :: ArgVrcs
146 | KindCon { -- Type constructor at the kind level
147 tyConUnique :: Unique,
149 tyConKind :: SuperKind,
153 | SuperKindCon { -- The type of kind variables or boxity variables,
154 tyConUnique :: Unique,
158 type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)]
159 -- *NB*: this is tyvar variance info, *not*
160 -- termvar usage info.
163 = DataTyCon -- Data type
164 | EnumTyCon -- Special sort of enumeration type
165 | NewTyCon Type -- Newtype, with its *ultimate* representation type
166 -- By 'ultimate' I mean that the rep type is not itself
167 -- a newtype or type synonym.
169 -- The rep type has explicit for-alls for the tyvars of
171 -- newtype T a = MkT [(a,Int)]
172 -- The rep type is forall a. [(a,Int)]
174 -- The rep type isn't entirely simple:
175 -- for a recursive newtype we pick () as the rep type
179 %************************************************************************
181 \subsection{TyCon Construction}
183 %************************************************************************
185 Note: the TyCon constructors all take a Kind as one argument, even though
186 they could, in principle, work out their Kind from their other arguments.
187 But to do so they need functions from Types, and that makes a nasty
188 module mutual-recursion. And they aren't called from many places.
189 So we compromise, and move their Kind calculation to the call site.
192 mkSuperKindCon :: Name -> SuperKindCon
193 mkSuperKindCon name = SuperKindCon {
194 tyConUnique = nameUnique name,
198 mkKindCon :: Name -> SuperKind -> KindCon
201 tyConUnique = nameUnique name,
207 mkFunTyCon :: Name -> Kind -> TyCon
210 tyConUnique = nameUnique name,
216 mkAlgTyCon name kind tyvars theta argvrcs cons derivs flavour rec
219 tyConUnique = nameUnique name,
221 tyConArity = length tyvars,
222 tyConTyVars = tyvars,
223 tyConArgVrcs = argvrcs,
224 algTyConTheta = theta,
226 algTyConDerivings = derivs,
227 algTyConClass_maybe = Nothing,
228 algTyConFlavour = flavour,
232 mkClassTyCon name kind tyvars argvrcs con clas flavour
235 tyConUnique = nameUnique name,
237 tyConArity = length tyvars,
238 tyConTyVars = tyvars,
239 tyConArgVrcs = argvrcs,
242 algTyConDerivings = [],
243 algTyConClass_maybe = Just clas,
244 algTyConFlavour = flavour,
245 algTyConRec = NonRecursive
249 mkTupleTyCon name kind arity tyvars con boxed
251 tyConUnique = nameUnique name,
256 tyConTyVars = tyvars,
260 mkPrimTyCon name kind arity arg_vrcs rep
263 tyConUnique = nameUnique name,
266 tyConArgVrcs = arg_vrcs,
270 mkSynTyCon name kind arity tyvars rhs argvrcs
273 tyConUnique = nameUnique name,
276 tyConTyVars = tyvars,
278 tyConArgVrcs = argvrcs
281 setTyConName tc name = tc {tyConName = name, tyConUnique = nameUnique name}
285 isFunTyCon (FunTyCon {}) = True
288 isPrimTyCon (PrimTyCon {}) = True
289 isPrimTyCon _ = False
291 isUnLiftedTyCon (PrimTyCon {}) = True
292 isUnLiftedTyCon (TupleTyCon { tyConBoxed = False }) = True
293 isUnLiftedTyCon _ = False
295 -- isBoxedTyCon should not be applied to SynTyCon, nor KindCon
296 isBoxedTyCon (AlgTyCon {}) = True
297 isBoxedTyCon (FunTyCon {}) = True
298 isBoxedTyCon (TupleTyCon {tyConBoxed = boxed}) = boxed
299 isBoxedTyCon (PrimTyCon {primTyConRep = rep}) = isFollowableRep rep
301 -- isAlgTyCon returns True for both @data@ and @newtype@
302 isAlgTyCon (AlgTyCon {}) = True
303 isAlgTyCon (TupleTyCon {}) = True
304 isAlgTyCon other = False
306 -- isDataTyCon returns False for @newtype@ and for unboxed tuples
307 isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data}) = case new_or_data of
310 isDataTyCon (TupleTyCon {tyConBoxed = True}) = True
311 isDataTyCon other = False
313 isNewTyCon (AlgTyCon {algTyConFlavour = NewTyCon _}) = True
314 isNewTyCon other = False
316 newTyConRep (AlgTyCon {algTyConFlavour = NewTyCon rep}) = Just rep
317 newTyConRep other = Nothing
320 -- has *one* constructor,
321 -- is *not* existential
323 -- may be DataType or NewType,
324 -- may be unboxed or not,
325 -- may be recursive or not
326 isProductTyCon (AlgTyCon {dataCons = [data_con]}) = not (isExistentialDataCon data_con)
327 isProductTyCon (TupleTyCon {}) = True
328 isProductTyCon other = False
330 isSynTyCon (SynTyCon {}) = True
333 isEnumerationTyCon (AlgTyCon {algTyConFlavour = EnumTyCon}) = True
334 isEnumerationTyCon other = False
336 -- The unit tycon isn't classed as a tuple tycon
337 isTupleTyCon (TupleTyCon {tyConArity = arity, tyConBoxed = True}) = arity >= 2
338 isTupleTyCon other = False
340 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = False}) = True
341 isUnboxedTupleTyCon other = False
343 isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True
344 isRecursiveTyCon other = False
348 tyConDataCons :: TyCon -> [DataCon]
349 tyConDataCons (AlgTyCon {dataCons = cons}) = cons
350 tyConDataCons (TupleTyCon {dataCon = con}) = [con]
351 tyConDataCons other = []
352 -- You may think this last equation should fail,
353 -- but it's quite convenient to return no constructors for
354 -- a synonym; see for example the call in TcTyClsDecls.
356 tyConFamilySize :: TyCon -> Int
357 tyConFamilySize (AlgTyCon {dataCons = cons}) = length cons
358 tyConFamilySize (TupleTyCon {}) = 1
360 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
363 tyConPrimRep :: TyCon -> PrimRep
364 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
365 tyConPrimRep _ = PtrRep
369 tyConDerivings :: TyCon -> [Class]
370 tyConDerivings (AlgTyCon {algTyConDerivings = derivs}) = derivs
371 tyConDerivings other = []
375 tyConTheta :: TyCon -> [(Class, [Type])]
376 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
377 -- should ask about anything else
380 @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
381 each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is
382 actually computed (in another file).
385 tyConArgVrcs_maybe :: TyCon -> Maybe ArgVrcs
387 tyConArgVrcs_maybe (FunTyCon {} ) = Just [(False,True),(True,False)]
388 tyConArgVrcs_maybe (AlgTyCon {tyConArgVrcs = oi}) = Just oi
389 tyConArgVrcs_maybe (PrimTyCon {tyConArgVrcs = oi}) = Just oi
390 tyConArgVrcs_maybe (TupleTyCon {tyConArity = arity }) = Just (replicate arity (True,False))
391 tyConArgVrcs_maybe (SynTyCon {tyConArgVrcs = oi }) = Just oi
392 tyConArgVrcs_maybe _ = Nothing
396 getSynTyConDefn :: TyCon -> ([TyVar], Type)
397 getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
401 maybeTyConSingleCon :: TyCon -> Maybe DataCon
402 maybeTyConSingleCon (AlgTyCon {dataCons = [c]}) = Just c
403 maybeTyConSingleCon (AlgTyCon {}) = Nothing
404 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
405 maybeTyConSingleCon (PrimTyCon {}) = Nothing
406 maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty
407 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $
412 tyConClass_maybe :: TyCon -> Maybe Class
413 tyConClass_maybe (AlgTyCon {algTyConClass_maybe = maybe_cls}) = maybe_cls
414 tyConClass_maybe other_tycon = Nothing
418 %************************************************************************
420 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
422 %************************************************************************
424 @TyCon@s are compared by comparing their @Unique@s.
426 The strictness analyser needs @Ord@. It is a lexicographic order with
427 the property @(a<=b) || (b<=a)@.
430 instance Eq TyCon where
431 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
432 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
434 instance Ord TyCon where
435 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
436 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
437 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
438 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
439 compare a b = getUnique a `compare` getUnique b
441 instance Uniquable TyCon where
442 getUnique tc = tyConUnique tc
444 instance Outputable TyCon where
445 ppr tc = ppr (getName tc)
447 instance NamedThing TyCon where
452 %************************************************************************
454 \subsection{Kind constructors}
456 %************************************************************************
458 @matchesTyCon tc1 tc2@ checks whether an appliation
459 (tc1 t1..tn) matches (tc2 t1..tn). By "matches" we basically mean "equals",
460 except that at the kind level tc2 might have more boxity info than tc1.
463 matchesTyCon :: TyCon -- Expected (e.g. arg type of function)
464 -> TyCon -- Inferred (e.g. type of actual arg to function)
467 matchesTyCon tc1 tc2 = uniq1 == uniq2 || uniq1 == anyBoxConKey
469 uniq1 = tyConUnique tc1
470 uniq2 = tyConUnique tc2