2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[TyCon]{The @TyCon@ datatype}
10 AlgTyConRhs(..), visibleDataCons,
12 isFunTyCon, isUnLiftedTyCon, isProductTyCon, isAbstractTyCon,
13 isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
15 isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
16 isRecursiveTyCon, newTyConRep, newTyConRhs, isHiBootTyCon,
18 mkForeignTyCon, isForeignTyCon,
33 algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
38 isClassTyCon, tyConClass_maybe,
40 tyConExtName, -- External name for foreign types
48 #include "HsVersions.h"
50 import {-# SOURCE #-} TypeRep ( Type, PredType )
51 -- Should just be Type(Type), but this fails due to bug present up to
52 -- and including 4.02 involving slurping of hi-boot files. Bug is now fixed.
54 import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon )
57 import Var ( TyVar, Id )
58 import Class ( Class )
60 import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed )
61 import Name ( Name, nameUnique, NamedThing(getName) )
62 import PrelNames ( Unique, Uniquable(..) )
63 import PrimRep ( PrimRep(..) )
64 import Maybes ( orElse )
69 %************************************************************************
71 \subsection{The data type}
73 %************************************************************************
78 tyConUnique :: Unique,
85 | AlgTyCon { -- Data type, and newtype decls.
86 -- All lifted, all boxed
87 tyConUnique :: Unique,
92 tyConTyVars :: [TyVar],
94 algTyConTheta :: [PredType],
96 selIds :: [Id], -- Its record selectors (if any)
98 algRhs :: AlgTyConRhs, -- Data constructors in here
100 algTyConRec :: RecFlag, -- Tells whether the data type is part of
101 -- a mutually-recursive group or not
103 hasGenerics :: Bool, -- True <=> generic to/from functions are available
104 -- (in the exports of the data type's source module)
106 algTyConClass :: Maybe Class
107 -- Just cl if this tycon came from a class declaration
110 | PrimTyCon { -- Primitive types; cannot be defined in Haskell
111 -- Now includes foreign-imported types
112 tyConUnique :: Unique,
117 primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are
118 -- boxed (represented by pointers). The PrimRep tells.
120 isUnLifted :: Bool, -- Most primitive tycons are unlifted,
121 -- but foreign-imported ones may not be
122 tyConExtName :: Maybe FastString -- Just xx for foreign-imported types
126 tyConUnique :: Unique,
130 tyConBoxed :: Boxity,
131 tyConTyVars :: [TyVar],
137 tyConUnique :: Unique,
142 tyConTyVars :: [TyVar], -- Bound tyvars
143 synTyConDefn :: Type, -- Right-hand side, mentioning these type vars.
144 -- Acts as a template for the expansion when
145 -- the tycon is applied to some types.
149 type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)]
150 -- [] means "no information, assume the worst"
153 = AbstractTyCon -- We know nothing about this data type, except
154 -- that it's represented by a pointer
155 -- Used when we export a data type abstractly into
159 [DataCon] -- The constructors; can be empty if the user declares
160 -- the type to have no constructors
161 Bool -- Cached: True <=> an enumeration type
163 | NewTyCon -- Newtypes always have exactly one constructor
164 DataCon -- The unique constructor; it has no existentials
165 Type -- Cached: the argument type of the constructor
166 -- = the representation type of the tycon
168 Type -- Cached: the *ultimate* representation type
169 -- By 'ultimate' I mean that the rep type is not itself
170 -- a newtype or type synonym.
171 -- The rep type isn't entirely simple:
172 -- for a recursive newtype we pick () as the rep type
175 -- The rep type has free type variables the tyConTyVars
177 -- newtype T a = MkT [(a,Int)]
178 -- The rep type is [(a,Int)]
179 -- NB: the rep type isn't necessarily the original RHS of the
180 -- newtype decl, because the rep type looks through other
183 visibleDataCons :: AlgTyConRhs -> [DataCon]
184 visibleDataCons AbstractTyCon = []
185 visibleDataCons (DataTyCon cs _) = cs
186 visibleDataCons (NewTyCon c _ _) = [c]
190 %************************************************************************
192 \subsection{TyCon Construction}
194 %************************************************************************
196 Note: the TyCon constructors all take a Kind as one argument, even though
197 they could, in principle, work out their Kind from their other arguments.
198 But to do so they need functions from Types, and that makes a nasty
199 module mutual-recursion. And they aren't called from many places.
200 So we compromise, and move their Kind calculation to the call site.
203 mkFunTyCon :: Name -> Kind -> TyCon
206 tyConUnique = nameUnique name,
212 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
213 -- but now you also have to pass in the generic information about the type
214 -- constructor - you can get hold of it easily (see Generics module)
215 mkAlgTyCon name kind tyvars theta argvrcs rhs sels is_rec gen_info
218 tyConUnique = nameUnique name,
220 tyConArity = length tyvars,
221 tyConTyVars = tyvars,
223 algTyConTheta = theta,
226 algTyConClass = Nothing,
227 algTyConRec = is_rec,
228 hasGenerics = gen_info
231 mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
234 tyConUnique = nameUnique name,
236 tyConArity = length tyvars,
237 tyConTyVars = tyvars,
242 algTyConClass = Just clas,
243 algTyConRec = is_rec,
248 mkTupleTyCon name kind arity tyvars con boxed gen_info
250 tyConUnique = nameUnique name,
255 tyConTyVars = tyvars,
257 hasGenerics = gen_info
260 -- Foreign-imported (.NET) type constructors are represented
261 -- as primitive, but *lifted*, TyCons for now. They are lifted
262 -- because the Haskell type T representing the (foreign) .NET
263 -- type T is actually implemented (in ILX) as a thunk<T>
265 mkForeignTyCon name ext_name kind arity arg_vrcs
268 tyConUnique = nameUnique name,
272 primTyConRep = PtrRep,
274 tyConExtName = ext_name
278 -- most Prim tycons are lifted
279 mkPrimTyCon name kind arity arg_vrcs rep
280 = mkPrimTyCon' name kind arity arg_vrcs rep True
282 -- but RealWorld is lifted
283 mkLiftedPrimTyCon name kind arity arg_vrcs rep
284 = mkPrimTyCon' name kind arity arg_vrcs rep False
286 mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
289 tyConUnique = nameUnique name,
294 isUnLifted = is_unlifted,
295 tyConExtName = Nothing
298 mkSynTyCon name kind tyvars rhs argvrcs
301 tyConUnique = nameUnique name,
303 tyConArity = length tyvars,
304 tyConTyVars = tyvars,
311 isFunTyCon :: TyCon -> Bool
312 isFunTyCon (FunTyCon {}) = True
315 isAbstractTyCon :: TyCon -> Bool
316 isAbstractTyCon (AlgTyCon { algRhs = AbstractTyCon }) = True
317 isAbstractTyCon _ = False
319 isPrimTyCon :: TyCon -> Bool
320 isPrimTyCon (PrimTyCon {}) = True
321 isPrimTyCon _ = False
323 isUnLiftedTyCon :: TyCon -> Bool
324 isUnLiftedTyCon (PrimTyCon {isUnLifted = is_unlifted}) = is_unlifted
325 isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
326 isUnLiftedTyCon _ = False
328 -- isAlgTyCon returns True for both @data@ and @newtype@
329 isAlgTyCon :: TyCon -> Bool
330 isAlgTyCon (AlgTyCon {}) = True
331 isAlgTyCon (TupleTyCon {}) = True
332 isAlgTyCon other = False
334 algTyConRhs :: TyCon -> AlgTyConRhs
335 algTyConRhs (AlgTyCon {algRhs = rhs}) = rhs
336 algTyConRhs (TupleTyCon {dataCon = dc}) = DataTyCon [dc] False
338 isDataTyCon :: TyCon -> Bool
339 -- isDataTyCon returns True for data types that are represented by
340 -- heap-allocated constructors.
341 -- These are srcutinised by Core-level @case@ expressions, and they
342 -- get info tables allocated for them.
343 -- True for all @data@ types
344 -- False for newtypes
346 isDataTyCon (AlgTyCon {algRhs = rhs})
348 DataTyCon _ _ -> True
349 NewTyCon _ _ _ -> False
350 AbstractTyCon -> panic "isDataTyCon"
352 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
353 isDataTyCon other = False
355 isNewTyCon :: TyCon -> Bool
356 isNewTyCon (AlgTyCon {algRhs = NewTyCon _ _ _}) = True
357 isNewTyCon other = False
359 isProductTyCon :: TyCon -> Bool
361 -- has *one* constructor,
362 -- is *not* existential
364 -- may be DataType or NewType,
365 -- may be unboxed or not,
366 -- may be recursive or not
367 isProductTyCon tc@(AlgTyCon {}) = case algRhs tc of
368 DataTyCon [data_con] _ -> not (isExistentialDataCon data_con)
369 NewTyCon _ _ _ -> True
371 isProductTyCon (TupleTyCon {}) = True
372 isProductTyCon other = False
374 isSynTyCon :: TyCon -> Bool
375 isSynTyCon (SynTyCon {}) = True
378 isEnumerationTyCon :: TyCon -> Bool
379 isEnumerationTyCon (AlgTyCon {algRhs = DataTyCon _ is_enum}) = is_enum
380 isEnumerationTyCon other = False
382 isTupleTyCon :: TyCon -> Bool
383 -- The unit tycon didn't used to be classed as a tuple tycon
384 -- but I thought that was silly so I've undone it
385 -- If it can't be for some reason, it should be a AlgTyCon
386 isTupleTyCon (TupleTyCon {}) = True
387 isTupleTyCon other = False
389 isUnboxedTupleTyCon :: TyCon -> Bool
390 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
391 isUnboxedTupleTyCon other = False
393 isBoxedTupleTyCon :: TyCon -> Bool
394 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
395 isBoxedTupleTyCon other = False
397 tupleTyConBoxity tc = tyConBoxed tc
399 isRecursiveTyCon :: TyCon -> Bool
400 isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True
401 isRecursiveTyCon other = False
403 isHiBootTyCon :: TyCon -> Bool
404 -- Used for knot-tying in hi-boot files
405 isHiBootTyCon (AlgTyCon {algRhs = AbstractTyCon}) = True
406 isHiBootTyCon other = False
408 isForeignTyCon :: TyCon -> Bool
409 -- isForeignTyCon identifies foreign-imported type constructors
410 -- For the moment, they are primitive but lifted, but that may change
411 isForeignTyCon (PrimTyCon {isUnLifted = is_unlifted}) = not is_unlifted
412 isForeignTyCon other = False
416 tyConHasGenerics :: TyCon -> Bool
417 tyConHasGenerics (AlgTyCon {hasGenerics = hg}) = hg
418 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
419 tyConHasGenerics other = False -- Synonyms
421 tyConDataCons :: TyCon -> [DataCon]
422 -- It's convenient for tyConDataCons to return the
423 -- empty list for type synonyms etc
424 tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
426 tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
427 tyConDataCons_maybe (AlgTyCon {algRhs = DataTyCon cons _}) = Just cons
428 tyConDataCons_maybe (AlgTyCon {algRhs = NewTyCon con _ _}) = Just [con]
429 tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con]
430 tyConDataCons_maybe other = Nothing
432 tyConFamilySize :: TyCon -> Int
433 tyConFamilySize (AlgTyCon {algRhs = DataTyCon cons _}) = length cons
434 tyConFamilySize (AlgTyCon {algRhs = NewTyCon _ _ _}) = 1
435 tyConFamilySize (TupleTyCon {}) = 1
437 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
440 tyConSelIds :: TyCon -> [Id]
441 tyConSelIds (AlgTyCon {selIds = sels}) = sels
442 tyConSelIds other_tycon = []
446 newTyConRep :: TyCon -> ([TyVar], Type)
447 newTyConRep (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ _ rep}) = (tvs, rep)
449 newTyConRhs :: TyCon -> ([TyVar], Type)
450 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ rhs _}) = (tvs, rhs)
452 tyConPrimRep :: TyCon -> PrimRep
453 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
454 tyConPrimRep tc = ASSERT( not (isUnboxedTupleTyCon tc) )
456 -- We should not be asking what the representation of an
457 -- unboxed tuple is, because it isn't a first class value.
461 tyConTheta :: TyCon -> [PredType]
462 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
463 tyConTheta (TupleTyCon {}) = []
464 -- shouldn't ask about anything else
467 @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
468 each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is
469 actually computed (in another file).
472 tyConArgVrcs :: TyCon -> ArgVrcs
473 tyConArgVrcs (FunTyCon {}) = [(False,True),(True,False)]
474 tyConArgVrcs (AlgTyCon {argVrcs = oi}) = oi
475 tyConArgVrcs (PrimTyCon {argVrcs = oi}) = oi
476 tyConArgVrcs (TupleTyCon {tyConArity = arity}) = (replicate arity (True,False))
477 tyConArgVrcs (SynTyCon {argVrcs = oi}) = oi
481 getSynTyConDefn :: TyCon -> ([TyVar], Type)
482 getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
486 maybeTyConSingleCon :: TyCon -> Maybe DataCon
487 maybeTyConSingleCon (AlgTyCon {algRhs = DataTyCon [c] _}) = Just c
488 maybeTyConSingleCon (AlgTyCon {algRhs = NewTyCon c _ _}) = Just c
489 maybeTyConSingleCon (AlgTyCon {}) = Nothing
490 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
491 maybeTyConSingleCon (PrimTyCon {}) = Nothing
492 maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty
493 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
497 isClassTyCon :: TyCon -> Bool
498 isClassTyCon (AlgTyCon {algTyConClass = Just _}) = True
499 isClassTyCon other_tycon = False
501 tyConClass_maybe :: TyCon -> Maybe Class
502 tyConClass_maybe (AlgTyCon {algTyConClass = maybe_clas}) = maybe_clas
503 tyConClass_maybe ther_tycon = Nothing
507 %************************************************************************
509 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
511 %************************************************************************
513 @TyCon@s are compared by comparing their @Unique@s.
515 The strictness analyser needs @Ord@. It is a lexicographic order with
516 the property @(a<=b) || (b<=a)@.
519 instance Eq TyCon where
520 a == b = case (a `compare` b) of { EQ -> True; _ -> False }
521 a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
523 instance Ord TyCon where
524 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
525 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
526 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
527 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
528 compare a b = getUnique a `compare` getUnique b
530 instance Uniquable TyCon where
531 getUnique tc = tyConUnique tc
533 instance Outputable TyCon where
534 ppr tc = ppr (getName tc)
536 instance NamedThing TyCon where