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