1464fabcc7d3aa7223d99b4ed88546b3267f8b33
[ghc.git] / compiler / types / TyCon.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[TyCon]{The @TyCon@ datatype}
5
6 \begin{code}
7 module TyCon(
8         TyCon, FieldLabel,
9
10         PrimRep(..),
11         tyConPrimRep,
12
13         AlgTyConRhs(..), visibleDataCons, AlgTyConParent(..),
14         SynTyConRhs(..),
15
16         isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
17         isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
18         isPrimTyCon, 
19         isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
20         assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
21         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
22         isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
23         isHiBootTyCon, isSuperKindTyCon,
24         isCoercionTyCon_maybe, isCoercionTyCon,
25
26         tcExpandTyCon_maybe, coreExpandTyCon_maybe,
27
28         makeTyConAbstract, isAbstractTyCon,
29
30         mkForeignTyCon, isForeignTyCon,
31
32         mkAlgTyCon,
33         mkClassTyCon,
34         mkFunTyCon,
35         mkPrimTyCon,
36         mkVoidPrimTyCon,
37         mkLiftedPrimTyCon,
38         mkTupleTyCon,
39         mkSynTyCon,
40         mkSuperKindTyCon,
41         mkCoercionTyCon,
42
43         tyConName,
44         tyConKind,
45         tyConUnique,
46         tyConTyVars,
47         algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
48         tyConSelIds,
49         tyConStupidTheta,
50         tyConArity,
51         isClassTyCon, tyConClass_maybe,
52         isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
53         synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
54         tyConExtName,           -- External name for foreign types
55
56         maybeTyConSingleCon,
57
58         -- Generics
59         tyConHasGenerics
60 ) where
61
62 #include "HsVersions.h"
63
64 import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
65 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
66
67 import Var              ( TyVar, Id )
68 import Class            ( Class )
69 import BasicTypes       ( Arity, RecFlag(..), Boxity(..), isBoxed )
70 import Name             ( Name, nameUnique, NamedThing(getName) )
71 import PrelNames        ( Unique, Uniquable(..) )
72 import Maybe            ( isJust )
73 import Maybes           ( orElse )
74 import Outputable
75 import FastString
76 \end{code}
77
78 %************************************************************************
79 %*                                                                      *
80 \subsection{The data type}
81 %*                                                                      *
82 %************************************************************************
83
84 \begin{code}
85 data TyCon
86   = FunTyCon {
87         tyConUnique :: Unique,
88         tyConName   :: Name,
89         tyConKind   :: Kind,
90         tyConArity  :: Arity
91     }
92
93
94   | AlgTyCon {          -- Data type, and newtype decls.
95                         -- All lifted, all boxed
96         tyConUnique :: Unique,
97         tyConName   :: Name,
98         tyConKind   :: Kind,
99         tyConArity  :: Arity,
100
101         tyConTyVars :: [TyVar],         -- Scopes over (a) the algTcStupidTheta
102                                         --             (b) the cached types in
103                                         --                 algTyConRhs.NewTyCon
104                                         -- But not over the data constructors
105
106         tyConArgPoss :: Maybe [Int],    -- for associated families: for each
107                                         -- tyvar in the AT decl, gives the
108                                         -- position of that tyvar in the class
109                                         -- argument list (starting from 0).
110                                         -- NB: Length is less than tyConArity
111                                         --     if higher kind signature.
112         
113         algTcSelIds :: [Id],            -- Its record selectors (empty if none)
114
115         algTcGadtSyntax  :: Bool,       -- True <=> the data type was declared using GADT syntax
116                                         -- That doesn't mean it's a true GADT; only that the "where"
117                                         --      form was used. This field is used only to guide
118                                         --      pretty-printinng
119         algTcStupidTheta :: [PredType], -- The "stupid theta" for the data type
120                                         -- (always empty for GADTs)
121
122         algTcRhs :: AlgTyConRhs,        -- Data constructors in here
123
124         algTcRec :: RecFlag,            -- Tells whether the data type is part
125                                         -- of a mutually-recursive group or not
126
127         hasGenerics :: Bool,            -- True <=> generic to/from functions are available
128                                         -- (in the exports of the data type's source module)
129
130         algTcParent :: AlgTyConParent   -- Gives the class or family tycon for
131                                         -- derived tycons representing classes
132                                         -- or family instances, respectively.
133     }
134
135   | TupleTyCon {
136         tyConUnique :: Unique,
137         tyConName   :: Name,
138         tyConKind   :: Kind,
139         tyConArity  :: Arity,
140         tyConBoxed  :: Boxity,
141         tyConTyVars :: [TyVar],
142         dataCon     :: DataCon,
143         hasGenerics :: Bool
144     }
145
146   | SynTyCon {
147         tyConUnique  :: Unique,
148         tyConName    :: Name,
149         tyConKind    :: Kind,
150         tyConArity   :: Arity,
151
152         tyConTyVars  :: [TyVar],        -- Bound tyvars
153
154         tyConArgPoss :: Maybe [Int],    -- for associated families: for each
155                                         -- tyvar in the AT decl, gives the
156                                         -- position of that tyvar in the class
157                                         -- argument list (starting from 0).
158                                         -- NB: Length is less than tyConArity
159                                         --     if higher kind signature.
160         
161         synTcRhs     :: SynTyConRhs     -- Expanded type in here
162     }
163
164   | PrimTyCon {                 -- Primitive types; cannot be defined in Haskell
165                                 -- Now includes foreign-imported types
166                                 -- Also includes Kinds
167         tyConUnique   :: Unique,
168         tyConName     :: Name,
169         tyConKind     :: Kind,
170         tyConArity    :: Arity,
171
172         primTyConRep  :: PrimRep,
173                         -- Many primitive tycons are unboxed, but some are
174                         -- boxed (represented by pointers). The CgRep tells.
175
176         isUnLifted   :: Bool,           -- Most primitive tycons are unlifted, 
177                                         -- but foreign-imported ones may not be
178         tyConExtName :: Maybe FastString        -- Just xx for foreign-imported types
179     }
180
181   | CoercionTyCon {     -- E.g. (:=:), sym, trans, left, right
182                         -- INVARIANT: coercions are always fully applied
183         tyConUnique :: Unique,
184         tyConName   :: Name,
185         tyConArity  :: Arity,
186         coKindFun   :: [Type] -> Kind
187     }
188         
189   | SuperKindTyCon {    -- Super Kinds, TY (box) and CO (diamond).
190                         -- They have no kind; and arity zero
191         tyConUnique :: Unique,
192         tyConName   :: Name
193     }
194
195 type KindCon = TyCon
196
197 type SuperKindCon = TyCon
198
199 type FieldLabel = Name
200
201 data AlgTyConRhs
202   = AbstractTyCon       -- We know nothing about this data type, except 
203                         -- that it's represented by a pointer
204                         -- Used when we export a data type abstractly into
205                         -- an hi file
206
207   | OpenDataTyCon       -- data family        (further instances can appear
208   | OpenNewTyCon        -- newtype family      at any time)
209
210   | DataTyCon {
211         data_cons :: [DataCon],
212                         -- The constructors; can be empty if the user declares
213                         --   the type to have no constructors
214                         -- INVARIANT: Kept in order of increasing tag
215                         --            (see the tag assignment in DataCon.mkDataCon)
216         is_enum :: Bool         -- Cached: True <=> an enumeration type
217     }                   --         Includes data types with no constructors.
218
219   | NewTyCon {
220         data_con :: DataCon,    -- The unique constructor; it has no existentials
221
222         nt_rhs :: Type,         -- Cached: the argument type of the constructor
223                                 --  = the representation type of the tycon
224                                 -- The free tyvars of this type are the tyConTyVars
225       
226         nt_co :: Maybe TyCon,   -- The coercion used to create the newtype
227                                 -- from the representation
228                                 -- optional for non-recursive newtypes
229                                 -- See Note [Newtype coercions]
230
231         nt_etad_rhs :: ([TyVar], Type) ,
232                         -- The same again, but this time eta-reduced
233                         -- hence the [TyVar] which may be shorter than the declared 
234                         -- arity of the TyCon.  See Note [Newtype eta]
235
236         nt_rep :: Type  -- Cached: the *ultimate* representation type
237                         -- By 'ultimate' I mean that the top-level constructor
238                         -- of the rep type is not itself a newtype or type synonym.
239                         -- The rep type isn't entirely simple:
240                         --  for a recursive newtype we pick () as the rep type
241                         --      newtype T = MkT T
242                         -- 
243                         -- This one does not need to be eta reduced; hence its
244                         -- free type variables are conveniently tyConTyVars
245                         -- Thus:
246                         --      newtype T a = MkT [(a,Int)]
247                         -- The rep type is [(a,Int)]
248                         -- NB: the rep type isn't necessarily the original RHS of the
249                         --     newtype decl, because the rep type looks through other
250     }                   --     newtypes.
251
252 visibleDataCons :: AlgTyConRhs -> [DataCon]
253 visibleDataCons AbstractTyCon                 = []
254 visibleDataCons OpenDataTyCon                 = []
255 visibleDataCons OpenNewTyCon                  = []
256 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
257 visibleDataCons (NewTyCon{ data_con = c })    = [c]
258
259 -- Both type classes as well as data/newtype family instances imply implicit
260 -- type constructors.  These implicit type constructors refer to their parent
261 -- structure (ie, the class or family from which they derive) using a type of
262 -- the following form.
263 --
264 data AlgTyConParent = -- An ordinary type constructor has no parent.
265                       NoParentTyCon
266
267                       -- Type constructors representing a class dictionary.
268                     | ClassTyCon    Class       
269
270                       -- Type constructors representing an instances of a type
271                       -- family.
272                     | FamilyTyCon   TyCon       -- the type family
273                                     [Type]      -- instance types
274                                     TyCon       -- a *coercion* identifying
275                                                 -- the representation type
276                                                 -- with the type instance
277
278 data SynTyConRhs
279   = OpenSynTyCon Kind   -- Type family: *result* kind given
280   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
281                         --  the expansion when the tycon is applied to some
282                         --  types.  
283 \end{code}
284
285 Note [Newtype coercions]
286 ~~~~~~~~~~~~~~~~~~~~~~~~
287
288 The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
289 which is used for coercing from the representation type of the
290 newtype, to the newtype itself. For example,
291
292    newtype T a = MkT (a -> a)
293
294 the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
295 t.  This TyCon is a CoercionTyCon, so it does not have a kind on its
296 own; it basically has its own typing rule for the fully-applied
297 version.  If the newtype T has k type variables then CoT has arity at
298 most k.  In the case that the right hand side is a type application
299 ending with the same type variables as the left hand side, we
300 "eta-contract" the coercion.  So if we had
301
302    newtype S a = MkT [a]
303
304 then we would generate the arity 0 coercion CoS : S :=: [].  The
305 primary reason we do this is to make newtype deriving cleaner.
306
307 In the paper we'd write
308         axiom CoT : (forall t. T t) :=: (forall t. [t])
309 and then when we used CoT at a particular type, s, we'd say
310         CoT @ s
311 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
312
313 But in GHC we instead make CoT into a new piece of type syntax
314 (like instCoercionTyCon, symCoercionTyCon etc), which must always
315 be saturated, but which encodes as
316         TyConApp CoT [s]
317 In the vocabulary of the paper it's as if we had axiom declarations
318 like
319         axiom CoT t :  T t :=: [t]
320
321 Note [Newtype eta]
322 ~~~~~~~~~~~~~~~~~~
323 Consider
324         newtype Parser m a = MkParser (Foogle m a)
325 Are these two types equal (to Core)?
326         Monad (Parser m) 
327         Monad (Foogle m)
328 Well, yes.  But to see that easily we eta-reduce the RHS type of
329 Parser, in this case to ([], Froogle), so that even unsaturated applications
330 of Parser will work right.  This eta reduction is done when the type 
331 constructor is built, and cached in NewTyCon.  The cached field is
332 only used in coreExpandTyCon_maybe.
333  
334 Here's an example that I think showed up in practice
335 Source code:
336         newtype T a = MkT [a]
337         newtype Foo m = MkFoo (forall a. m a -> Int)
338
339         w1 :: Foo []
340         w1 = ...
341         
342         w2 :: Foo T
343         w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
344
345 After desugaring, and discading the data constructors for the newtypes,
346 we get:
347         w2 :: Foo T
348         w2 = w1
349 And now Lint complains unless Foo T == Foo [], and that requires T==[]
350
351
352 %************************************************************************
353 %*                                                                      *
354 \subsection{PrimRep}
355 %*                                                                      *
356 %************************************************************************
357
358 A PrimRep is an abstraction of a type.  It contains information that
359 the code generator needs in order to pass arguments, return results,
360 and store values of this type.
361
362 A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
363 MachRep (see cmm/MachOp), although each of these types has a distinct
364 and clearly defined purpose:
365
366   - A PrimRep is a CgRep + information about signedness + information
367     about primitive pointers (AddrRep).  Signedness and primitive
368     pointers are required when passing a primitive type to a foreign
369     function, but aren't needed for call/return conventions of Haskell
370     functions.
371
372   - A MachRep is a basic machine type (non-void, doesn't contain
373     information on pointerhood or signedness, but contains some
374     reps that don't have corresponding Haskell types).
375
376 \begin{code}
377 data PrimRep
378   = VoidRep
379   | PtrRep
380   | IntRep              -- signed, word-sized
381   | WordRep             -- unsinged, word-sized
382   | Int64Rep            -- signed, 64 bit (32-bit words only)
383   | Word64Rep           -- unsigned, 64 bit (32-bit words only)
384   | AddrRep             -- a pointer, but not to a Haskell value
385   | FloatRep
386   | DoubleRep
387 \end{code}
388
389 %************************************************************************
390 %*                                                                      *
391 \subsection{TyCon Construction}
392 %*                                                                      *
393 %************************************************************************
394
395 Note: the TyCon constructors all take a Kind as one argument, even though
396 they could, in principle, work out their Kind from their other arguments.
397 But to do so they need functions from Types, and that makes a nasty
398 module mutual-recursion.  And they aren't called from many places.
399 So we compromise, and move their Kind calculation to the call site.
400
401 \begin{code}
402 mkFunTyCon :: Name -> Kind -> TyCon
403 mkFunTyCon name kind 
404   = FunTyCon { 
405         tyConUnique = nameUnique name,
406         tyConName   = name,
407         tyConKind   = kind,
408         tyConArity  = 2
409     }
410
411 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
412 -- but now you also have to pass in the generic information about the type
413 -- constructor - you can get hold of it easily (see Generics module)
414 mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
415   = AlgTyCon {  
416         tyConName        = name,
417         tyConUnique      = nameUnique name,
418         tyConKind        = kind,
419         tyConArity       = length tyvars,
420         tyConTyVars      = tyvars,
421         tyConArgPoss     = Nothing,
422         algTcStupidTheta = stupid,
423         algTcRhs         = rhs,
424         algTcSelIds      = sel_ids,
425         algTcParent      = parent,
426         algTcRec         = is_rec,
427         algTcGadtSyntax  = gadt_syn,
428         hasGenerics = gen_info
429     }
430
431 mkClassTyCon name kind tyvars rhs clas is_rec =
432   mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
433
434 mkTupleTyCon name kind arity tyvars con boxed gen_info
435   = TupleTyCon {
436         tyConUnique = nameUnique name,
437         tyConName = name,
438         tyConKind = kind,
439         tyConArity = arity,
440         tyConBoxed = boxed,
441         tyConTyVars = tyvars,
442         dataCon = con,
443         hasGenerics = gen_info
444     }
445
446 -- Foreign-imported (.NET) type constructors are represented
447 -- as primitive, but *lifted*, TyCons for now. They are lifted
448 -- because the Haskell type T representing the (foreign) .NET
449 -- type T is actually implemented (in ILX) as a thunk<T>
450 mkForeignTyCon name ext_name kind arity
451   = PrimTyCon {
452         tyConName    = name,
453         tyConUnique  = nameUnique name,
454         tyConKind    = kind,
455         tyConArity   = arity,
456         primTyConRep = PtrRep, -- they all do
457         isUnLifted   = False,
458         tyConExtName = ext_name
459     }
460
461
462 -- most Prim tycons are lifted
463 mkPrimTyCon name kind arity rep
464   = mkPrimTyCon' name kind arity rep True  
465
466 mkVoidPrimTyCon name kind arity 
467   = mkPrimTyCon' name kind arity VoidRep True  
468
469 -- but RealWorld is lifted
470 mkLiftedPrimTyCon name kind arity rep
471   = mkPrimTyCon' name kind arity rep False
472
473 mkPrimTyCon' name kind arity rep is_unlifted
474   = PrimTyCon {
475         tyConName    = name,
476         tyConUnique  = nameUnique name,
477         tyConKind    = kind,
478         tyConArity   = arity,
479         primTyConRep = rep,
480         isUnLifted   = is_unlifted,
481         tyConExtName = Nothing
482     }
483
484 mkSynTyCon name kind tyvars rhs
485   = SynTyCon {  
486         tyConName = name,
487         tyConUnique = nameUnique name,
488         tyConKind = kind,
489         tyConArity = length tyvars,
490         tyConTyVars = tyvars,
491         tyConArgPoss = Nothing,
492         synTcRhs = rhs
493     }
494
495 mkCoercionTyCon name arity kindRule
496   = CoercionTyCon {
497         tyConName = name,
498         tyConUnique = nameUnique name,
499         tyConArity = arity,
500         coKindFun = kindRule
501     }
502
503 -- Super kinds always have arity zero
504 mkSuperKindTyCon name
505   = SuperKindTyCon {
506         tyConName = name,
507         tyConUnique = nameUnique name
508   }
509 \end{code}
510
511 \begin{code}
512 isFunTyCon :: TyCon -> Bool
513 isFunTyCon (FunTyCon {}) = True
514 isFunTyCon _             = False
515
516 isAbstractTyCon :: TyCon -> Bool
517 isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
518 isAbstractTyCon _ = False
519
520 makeTyConAbstract :: TyCon -> TyCon
521 makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
522 makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)
523
524 isPrimTyCon :: TyCon -> Bool
525 isPrimTyCon (PrimTyCon {}) = True
526 isPrimTyCon _              = False
527
528 isUnLiftedTyCon :: TyCon -> Bool
529 isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
530 isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
531 isUnLiftedTyCon _                                       = False
532
533 -- isAlgTyCon returns True for both @data@ and @newtype@
534 isAlgTyCon :: TyCon -> Bool
535 isAlgTyCon (AlgTyCon {})   = True
536 isAlgTyCon (TupleTyCon {}) = True
537 isAlgTyCon other           = False
538
539 isDataTyCon :: TyCon -> Bool
540 -- isDataTyCon returns True for data types that are represented by
541 -- heap-allocated constructors.
542 -- These are srcutinised by Core-level @case@ expressions, and they
543 -- get info tables allocated for them.
544 --      True for all @data@ types
545 --      False for newtypes
546 --                unboxed tuples
547 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
548   = case rhs of
549         OpenDataTyCon -> True
550         DataTyCon {}  -> True
551         OpenNewTyCon  -> False
552         NewTyCon {}   -> False
553         AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
554 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
555 isDataTyCon other = False
556
557 isNewTyCon :: TyCon -> Bool
558 isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
559                                            OpenNewTyCon -> True
560                                            NewTyCon {}  -> True
561                                            _            -> False
562 isNewTyCon other                        = False
563
564 -- This is an important refinement as typical newtype optimisations do *not*
565 -- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
566 -- family, there is no unique right hand side by which `T a' can be replaced
567 -- by a cast.
568 --
569 isClosedNewTyCon :: TyCon -> Bool
570 isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
571
572 isProductTyCon :: TyCon -> Bool
573 -- A "product" tycon
574 --      has *one* constructor, 
575 --      is *not* existential
576 -- but
577 --      may be  DataType, NewType
578 --      may be  unboxed or not, 
579 --      may be  recursive or not
580 -- 
581 isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
582                                     DataTyCon{ data_cons = [data_con] } 
583                                                 -> isVanillaDataCon data_con
584                                     NewTyCon {} -> True
585                                     other       -> False
586 isProductTyCon (TupleTyCon {})  = True   
587 isProductTyCon other            = False
588
589 isSynTyCon :: TyCon -> Bool
590 isSynTyCon (SynTyCon {}) = True
591 isSynTyCon _             = False
592
593 isGadtSyntaxTyCon :: TyCon -> Bool
594 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
595 isGadtSyntaxTyCon other                                = False
596
597 isEnumerationTyCon :: TyCon -> Bool
598 isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
599 isEnumerationTyCon other                                               = False
600
601 isOpenTyCon :: TyCon -> Bool
602 isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _}) = True
603 isOpenTyCon (AlgTyCon {algTcRhs = OpenDataTyCon }) = True
604 isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon  }) = True
605 isOpenTyCon _                                      = False
606
607 assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
608 assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss
609 assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss
610 assocTyConArgPoss_maybe _                                  = Nothing
611
612 isTyConAssoc :: TyCon -> Bool
613 isTyConAssoc = isJust . assocTyConArgPoss_maybe
614
615 setTyConArgPoss :: TyCon -> [Int] -> TyCon
616 setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss }
617 setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss }
618 setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
619
620 isTupleTyCon :: TyCon -> Bool
621 -- The unit tycon didn't used to be classed as a tuple tycon
622 -- but I thought that was silly so I've undone it
623 -- If it can't be for some reason, it should be a AlgTyCon
624 --
625 -- NB: when compiling Data.Tuple, the tycons won't reply True to
626 -- isTupleTyCon, becuase they are built as AlgTyCons.  However they
627 -- get spat into the interface file as tuple tycons, so I don't think
628 -- it matters.
629 isTupleTyCon (TupleTyCon {}) = True
630 isTupleTyCon other           = False
631
632 isUnboxedTupleTyCon :: TyCon -> Bool
633 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
634 isUnboxedTupleTyCon other = False
635
636 isBoxedTupleTyCon :: TyCon -> Bool
637 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
638 isBoxedTupleTyCon other = False
639
640 tupleTyConBoxity tc = tyConBoxed tc
641
642 isRecursiveTyCon :: TyCon -> Bool
643 isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
644 isRecursiveTyCon other                                = False
645
646 isHiBootTyCon :: TyCon -> Bool
647 -- Used for knot-tying in hi-boot files
648 isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
649 isHiBootTyCon other                                 = False
650
651 isForeignTyCon :: TyCon -> Bool
652 -- isForeignTyCon identifies foreign-imported type constructors
653 isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
654 isForeignTyCon other                               = False
655
656 isSuperKindTyCon :: TyCon -> Bool
657 isSuperKindTyCon (SuperKindTyCon {}) = True
658 isSuperKindTyCon other               = False
659
660 isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
661 isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) 
662   = Just (ar, rule)
663 isCoercionTyCon_maybe other = Nothing
664
665 isCoercionTyCon (CoercionTyCon {}) = True
666 isCoercionTyCon other              = False
667 \end{code}
668
669
670 -----------------------------------------------
671 --      Expand type-constructor applications
672 -----------------------------------------------
673
674 \begin{code}
675 tcExpandTyCon_maybe, coreExpandTyCon_maybe 
676         :: TyCon 
677         -> [Type]                       -- Args to tycon
678         -> Maybe ([(TyVar,Type)],       -- Substitution
679                   Type,                 -- Body type (not yet substituted)
680                   [Type])               -- Leftover args
681
682 -- For the *typechecker* view, we expand synonyms only
683 tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, 
684                                synTcRhs = SynonymTyCon rhs }) tys
685    = expand tvs rhs tys
686 tcExpandTyCon_maybe other_tycon tys = Nothing
687
688 ---------------
689 -- For the *Core* view, we expand synonyms only as well
690
691 coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,       -- Not recursive
692          algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
693    = case etad_rhs of   -- Don't do this in the pattern match, lest we accidentally
694                         -- match the etad_rhs of a *recursive* newtype
695         (tvs,rhs) -> expand tvs rhs tys
696
697 coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
698
699
700 ----------------
701 expand  :: [TyVar] -> Type                      -- Template
702         -> [Type]                               -- Args
703         -> Maybe ([(TyVar,Type)], Type, [Type]) -- Expansion
704 expand tvs rhs tys
705   = case n_tvs `compare` length tys of
706         LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
707         EQ -> Just (tvs `zip` tys, rhs, [])
708         GT -> Nothing
709    where
710      n_tvs = length tvs
711 \end{code}
712
713 \begin{code}
714 tyConHasGenerics :: TyCon -> Bool
715 tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
716 tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
717 tyConHasGenerics other                           = False        -- Synonyms
718
719 tyConDataCons :: TyCon -> [DataCon]
720 -- It's convenient for tyConDataCons to return the
721 -- empty list for type synonyms etc
722 tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
723
724 tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
725 tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
726 tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
727 tyConDataCons_maybe (TupleTyCon {dataCon = con})                           = Just [con]
728 tyConDataCons_maybe other                                                  = Nothing
729
730 tyConFamilySize  :: TyCon -> Int
731 tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
732   length cons
733 tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
734 tyConFamilySize (AlgTyCon   {algTcRhs = OpenDataTyCon})                = 0
735 tyConFamilySize (TupleTyCon {})                                        = 1
736 #ifdef DEBUG
737 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
738 #endif
739
740 tyConSelIds :: TyCon -> [Id]
741 tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
742 tyConSelIds other_tycon                   = []
743
744 algTyConRhs :: TyCon -> AlgTyConRhs
745 algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
746 algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
747 algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
748 \end{code}
749
750 \begin{code}
751 newTyConRhs :: TyCon -> ([TyVar], Type)
752 newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
753 newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
754
755 newTyConRep :: TyCon -> ([TyVar], Type)
756 newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
757 newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
758
759 newTyConCo :: TyCon -> Maybe TyCon
760 newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }})
761   = co
762 newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = OpenNewTyCon})
763   = Nothing
764 newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon)
765
766 tyConPrimRep :: TyCon -> PrimRep
767 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
768 tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
769 \end{code}
770
771 \begin{code}
772 tyConStupidTheta :: TyCon -> [PredType]
773 tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
774 tyConStupidTheta (TupleTyCon {})                        = []
775 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
776 \end{code}
777
778 \begin{code}
779 synTyConDefn :: TyCon -> ([TyVar], Type)
780 synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty}) 
781   = (tyvars, ty)
782 synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
783
784 synTyConRhs :: TyCon -> SynTyConRhs
785 synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
786 synTyConRhs tc                          = pprPanic "synTyConRhs" (ppr tc)
787
788 synTyConType :: TyCon -> Type
789 synTyConType tc = case synTcRhs tc of
790                     SynonymTyCon t -> t
791                     _              -> pprPanic "synTyConType" (ppr tc)
792
793 synTyConResKind :: TyCon -> Kind
794 synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind}) = kind
795 synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
796 \end{code}
797
798 \begin{code}
799 maybeTyConSingleCon :: TyCon -> Maybe DataCon
800 maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
801 maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
802 maybeTyConSingleCon (AlgTyCon {})                = Nothing
803 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
804 maybeTyConSingleCon (PrimTyCon {})               = Nothing
805 maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
806 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
807 \end{code}
808
809 \begin{code}
810 isClassTyCon :: TyCon -> Bool
811 isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
812 isClassTyCon other_tycon                             = False
813
814 tyConClass_maybe :: TyCon -> Maybe Class
815 tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
816 tyConClass_maybe ther_tycon                                 = Nothing
817
818 isFamInstTyCon :: TyCon -> Bool
819 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _}) = True
820 isFamInstTyCon other_tycon                                  = False
821
822 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
823 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
824   Just (fam, instTys)
825 tyConFamInst_maybe ther_tycon                                           = 
826   Nothing
827
828 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
829 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
830   Just coe
831 tyConFamilyCoercion_maybe ther_tycon                                     = 
832   Nothing
833 \end{code}
834
835
836 %************************************************************************
837 %*                                                                      *
838 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
839 %*                                                                      *
840 %************************************************************************
841
842 @TyCon@s are compared by comparing their @Unique@s.
843
844 The strictness analyser needs @Ord@. It is a lexicographic order with
845 the property @(a<=b) || (b<=a)@.
846
847 \begin{code}
848 instance Eq TyCon where
849     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
850     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
851
852 instance Ord TyCon where
853     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
854     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
855     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
856     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
857     compare a b = getUnique a `compare` getUnique b
858
859 instance Uniquable TyCon where
860     getUnique tc = tyConUnique tc
861
862 instance Outputable TyCon where
863     ppr tc  = ppr (getName tc) 
864
865 instance NamedThing TyCon where
866     getName = tyConName
867 \end{code}