[project @ 2001-05-24 13:59:09 by simonpj]
[ghc-hetmet.git] / ghc / 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, KindCon, SuperKindCon, ArgVrcs, AlgTyConFlavour(..),
9
10         isFunTyCon, isUnLiftedTyCon, isBoxedTyCon, isProductTyCon,
11         isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
12         isEnumerationTyCon, 
13         isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
14         isRecursiveTyCon, newTyConRep,
15
16         mkForeignTyCon, isForeignTyCon,
17
18         mkAlgTyCon, --mkAlgTyCon, 
19         mkClassTyCon,
20         mkFunTyCon,
21         mkPrimTyCon,
22         mkTupleTyCon,
23         mkSynTyCon,
24         mkKindCon,
25         mkSuperKindCon,
26
27         setTyConName,
28
29         tyConName,
30         tyConKind,
31         tyConUnique,
32         tyConTyVars,
33         tyConArgVrcs_maybe,
34         tyConDataCons, tyConDataConsIfAvailable, tyConFamilySize,
35         tyConSelIds,
36         tyConTheta,
37         tyConPrimRep,
38         tyConArity,
39         isClassTyCon, tyConClass_maybe,
40         getSynTyConDefn,
41
42         maybeTyConSingleCon,
43
44         matchesTyCon,
45
46         -- Generics
47         tyConGenIds, tyConGenInfo
48 ) where
49
50 #include "HsVersions.h"
51
52 import {-# SOURCE #-} TypeRep ( Type, PredType, Kind, SuperKind )
53  -- Should just be Type(Type), but this fails due to bug present up to
54  -- and including 4.02 involving slurping of hi-boot files.  Bug is now fixed.
55
56 import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon )
57
58
59 import Var              ( TyVar, Id )
60 import Class            ( Class )
61 import BasicTypes       ( Arity, RecFlag(..), Boxity(..), 
62                           isBoxed, EP(..) )
63 import Name             ( Name, nameUnique, NamedThing(getName) )
64 import PrelNames        ( Unique, Uniquable(..), anyBoxConKey )
65 import PrimRep          ( PrimRep(..), isFollowableRep )
66 import Outputable
67 \end{code}
68
69 %************************************************************************
70 %*                                                                      *
71 \subsection{The data type}
72 %*                                                                      *
73 %************************************************************************
74
75 \begin{code}
76 type KindCon      = TyCon
77 type SuperKindCon = TyCon
78
79 data TyCon
80   = FunTyCon {
81         tyConUnique :: Unique,
82         tyConName   :: Name,
83         tyConKind   :: Kind,
84         tyConArity  :: Arity
85     }
86
87
88   | AlgTyCon {          -- Tuples, data type, and newtype decls.
89                         -- All lifted, all boxed
90         tyConUnique :: Unique,
91         tyConName   :: Name,
92         tyConKind   :: Kind,
93         tyConArity  :: Arity,
94         
95         tyConTyVars   :: [TyVar],
96         tyConArgVrcs  :: ArgVrcs,
97         algTyConTheta :: [PredType],
98
99         dataCons :: [DataCon],
100                 -- Its data constructors, with fully polymorphic types
101                 --      This list can be empty, when we import a data type abstractly,
102                 --      either (a) the interface is hand-written and doesn't give
103                 --                 the constructors, or
104                 --             (b) in a quest for fast compilation we don't import 
105                 --                 the constructors
106
107         selIds :: [Id], -- Its record selectors (if any)
108
109         noOfDataCons :: Int,    -- Number of data constructors
110                                 -- Usually this is the same as the length of the
111                                 -- dataCons field, but the latter may be empty if
112                                 -- we imported the type abstractly.  But even if we import
113                                 -- abstractly we still need to know the number of constructors
114                                 -- so we can get the return convention right.  Tiresome!
115                                 
116         algTyConFlavour :: AlgTyConFlavour,
117         algTyConRec     :: RecFlag,             -- Tells whether the data type is part of 
118                                                 -- a mutually-recursive group or not
119
120         genInfo :: Maybe (EP Id),       -- Convert T <-> Tring
121                                         -- Some TyCons don't have it; 
122                                         -- e.g. the TyCon for a Class dictionary,
123                                         -- and TyCons with unboxed arguments
124
125         algTyConClass :: Maybe Class    -- Just cl if this tycon came from a class declaration
126     }
127
128   | PrimTyCon {                 -- Primitive types; cannot be defined in Haskell
129                                 -- Now includes foreign-imported types
130         tyConUnique  :: Unique,
131         tyConName    :: Name,
132         tyConKind    :: Kind,
133         tyConArity   :: Arity,
134         tyConArgVrcs :: ArgVrcs,
135         primTyConRep :: PrimRep,        -- Many primitive tycons are unboxed, but some are
136                                         -- boxed (represented by pointers). The PrimRep tells.
137
138         isUnLifted   :: Bool    -- Most primitive tycons are unlifted, 
139                                 -- but foreign-imported ones may not be
140     }
141
142   | TupleTyCon {
143
144         tyConUnique :: Unique,
145         tyConName   :: Name,
146         tyConKind   :: Kind,
147         tyConArity  :: Arity,
148         tyConBoxed  :: Boxity,
149         tyConTyVars :: [TyVar],
150         dataCon     :: DataCon,
151         genInfo     :: Maybe (EP Id)            -- Generic type and conv funs 
152     }
153
154   | SynTyCon {
155         tyConUnique :: Unique,
156         tyConName   :: Name,
157         tyConKind   :: Kind,
158         tyConArity  :: Arity,
159
160         tyConTyVars     :: [TyVar],     -- Bound tyvars
161         synTyConDefn    :: Type,        -- Right-hand side, mentioning these type vars.
162                                         -- Acts as a template for the expansion when
163                                         -- the tycon is applied to some types.
164         tyConArgVrcs :: ArgVrcs
165     }
166
167   | KindCon {           -- Type constructor at the kind level
168         tyConUnique :: Unique,
169         tyConName   :: Name,
170         tyConKind   :: SuperKind,
171         tyConArity  :: Arity
172     }
173
174   | SuperKindCon        {               -- The type of kind variables or boxity variables,
175         tyConUnique :: Unique,
176         tyConName   :: Name
177     }
178
179 type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
180
181 data AlgTyConFlavour
182   = DataTyCon           -- Data type
183   | EnumTyCon           -- Special sort of enumeration type
184   | NewTyCon Type       -- Newtype, with its *ultimate* representation type
185                         -- By 'ultimate' I mean that the rep type is not itself
186                         -- a newtype or type synonym.
187
188                         -- The rep type has explicit for-alls for the tyvars of
189                         -- the TyCon.  Thus:
190                         --      newtype T a = MkT [(a,Int)]
191                         -- The rep type is forall a. [(a,Int)]
192                         --
193                         -- The rep type isn't entirely simple:
194                         --  for a recursive newtype we pick () as the rep type
195                         --      newtype T = MkT T
196 \end{code}
197
198 %************************************************************************
199 %*                                                                      *
200 \subsection{TyCon Construction}
201 %*                                                                      *
202 %************************************************************************
203
204 Note: the TyCon constructors all take a Kind as one argument, even though
205 they could, in principle, work out their Kind from their other arguments.
206 But to do so they need functions from Types, and that makes a nasty
207 module mutual-recursion.  And they aren't called from many places.
208 So we compromise, and move their Kind calculation to the call site.
209
210 \begin{code}
211 mkSuperKindCon :: Name -> SuperKindCon
212 mkSuperKindCon name = SuperKindCon {
213                         tyConUnique = nameUnique name,
214                         tyConName = name
215                       }
216
217 mkKindCon :: Name -> SuperKind -> KindCon
218 mkKindCon name kind
219   = KindCon { 
220         tyConUnique = nameUnique name,
221         tyConName = name,
222         tyConArity = 0,
223         tyConKind = kind
224      }
225
226 mkFunTyCon :: Name -> Kind -> TyCon
227 mkFunTyCon name kind 
228   = FunTyCon { 
229         tyConUnique = nameUnique name,
230         tyConName   = name,
231         tyConKind   = kind,
232         tyConArity  = 2
233     }
234
235 tyConGenInfo :: TyCon -> Maybe (EP Id)
236 tyConGenInfo (AlgTyCon   { genInfo = info }) = info
237 tyConGenInfo (TupleTyCon { genInfo = info }) = info
238 tyConGenInfo other                           = Nothing
239
240 tyConGenIds :: TyCon -> [Id]
241 -- Returns the generic-programming Ids; these Ids need bindings
242 tyConGenIds tycon = case tyConGenInfo tycon of
243                         Nothing           -> []
244                         Just (EP from to) -> [from,to]
245
246 -- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
247 -- but now you also have to pass in the generic information about the type
248 -- constructor - you can get hold of it easily (see Generics module)
249 mkAlgTyCon name kind tyvars theta argvrcs cons ncons sels flavour rec 
250               gen_info
251   = AlgTyCon {  
252         tyConName               = name,
253         tyConUnique             = nameUnique name,
254         tyConKind               = kind,
255         tyConArity              = length tyvars,
256         tyConTyVars             = tyvars,
257         tyConArgVrcs            = argvrcs,
258         algTyConTheta           = theta,
259         dataCons                = cons, 
260         selIds                  = sels,
261         noOfDataCons            = ncons,
262         algTyConClass           = Nothing,
263         algTyConFlavour         = flavour,
264         algTyConRec             = rec,
265         genInfo                 = gen_info
266     }
267
268 mkClassTyCon name kind tyvars argvrcs con clas flavour
269   = AlgTyCon {  
270         tyConName               = name,
271         tyConUnique             = nameUnique name,
272         tyConKind               = kind,
273         tyConArity              = length tyvars,
274         tyConTyVars             = tyvars,
275         tyConArgVrcs            = argvrcs,
276         algTyConTheta           = [],
277         dataCons                = [con],
278         selIds                  = [],
279         noOfDataCons            = 1,
280         algTyConClass           = Just clas,
281         algTyConFlavour         = flavour,
282         algTyConRec             = NonRecursive,
283         genInfo                 = Nothing
284     }
285
286
287 mkTupleTyCon name kind arity tyvars con boxed gen_info
288   = TupleTyCon {
289         tyConUnique = nameUnique name,
290         tyConName = name,
291         tyConKind = kind,
292         tyConArity = arity,
293         tyConBoxed = boxed,
294         tyConTyVars = tyvars,
295         dataCon = con,
296         genInfo = gen_info
297     }
298
299 -- Foreign-imported (.NET) type constructors are represented
300 -- as primitive, but *lifted*, TyCons for now.  
301 -- They  have PtrRep
302 mkForeignTyCon name kind arity arg_vrcs
303   = PrimTyCon {
304         tyConName    = name,
305         tyConUnique  = nameUnique name,
306         tyConKind    = kind,
307         tyConArity   = arity,
308         tyConArgVrcs = arg_vrcs,
309         primTyConRep = PtrRep,
310         isUnLifted   = False
311     }
312
313
314 mkPrimTyCon name kind arity arg_vrcs rep
315   = PrimTyCon {
316         tyConName    = name,
317         tyConUnique  = nameUnique name,
318         tyConKind    = kind,
319         tyConArity   = arity,
320         tyConArgVrcs = arg_vrcs,
321         primTyConRep = rep,
322         isUnLifted   = True
323     }
324
325 mkSynTyCon name kind arity tyvars rhs argvrcs
326   = SynTyCon {  
327         tyConName = name,
328         tyConUnique = nameUnique name,
329         tyConKind = kind,
330         tyConArity = arity,
331         tyConTyVars = tyvars,
332         synTyConDefn = rhs,
333         tyConArgVrcs = argvrcs
334     }
335
336 setTyConName tc name = tc {tyConName = name, tyConUnique = nameUnique name}
337
338 \end{code}
339
340 \begin{code}
341 isFunTyCon (FunTyCon {}) = True
342 isFunTyCon _             = False
343
344 isPrimTyCon (PrimTyCon {}) = True
345 isPrimTyCon _              = False
346
347 isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
348 isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
349 isUnLiftedTyCon _                                       = False
350
351 -- isBoxedTyCon should not be applied to SynTyCon, nor KindCon
352 isBoxedTyCon (AlgTyCon {}) = True
353 isBoxedTyCon (FunTyCon {}) = True
354 isBoxedTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
355 isBoxedTyCon (PrimTyCon {primTyConRep = rep}) = isFollowableRep rep
356
357 -- isAlgTyCon returns True for both @data@ and @newtype@
358 isAlgTyCon (AlgTyCon {})   = True
359 isAlgTyCon (TupleTyCon {}) = True
360 isAlgTyCon other           = False
361
362 -- isDataTyCon returns False for @newtype@ and for unboxed tuples
363 isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data})  = case new_or_data of
364                                                                 NewTyCon _ -> False
365                                                                 other   -> True
366 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
367 isDataTyCon other = False
368
369 isNewTyCon (AlgTyCon {algTyConFlavour = NewTyCon _}) = True 
370 isNewTyCon other                                     = False
371
372 newTyConRep (AlgTyCon {algTyConFlavour = NewTyCon rep}) = Just rep
373 newTyConRep other                                       = Nothing
374
375 -- A "product" tycon
376 --      has *one* constructor, 
377 --      is *not* existential
378 -- but
379 --      may be  DataType or NewType, 
380 --      may be  unboxed or not, 
381 --      may be  recursive or not
382 isProductTyCon (AlgTyCon {dataCons = [data_con]}) = not (isExistentialDataCon data_con)
383 isProductTyCon (TupleTyCon {})                    = True
384 isProductTyCon other                              = False
385
386 isSynTyCon (SynTyCon {}) = True
387 isSynTyCon _             = False
388
389 isEnumerationTyCon (AlgTyCon {algTyConFlavour = EnumTyCon}) = True
390 isEnumerationTyCon other                                    = False
391
392 -- The unit tycon didn't used to be classed as a tuple tycon
393 -- but I thought that was silly so I've undone it
394 -- If it can't be for some reason, it should be a AlgTyCon
395 isTupleTyCon (TupleTyCon {}) = True
396 isTupleTyCon other           = False
397
398 isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
399 isUnboxedTupleTyCon other = False
400
401 isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
402 isBoxedTupleTyCon other = False
403
404 tupleTyConBoxity tc = tyConBoxed tc
405
406 isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True
407 isRecursiveTyCon other                                = False
408
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
413 \end{code}
414
415 \begin{code}
416 tyConDataCons :: TyCon -> [DataCon]
417 tyConDataCons tycon = ASSERT2( not (null cons), ppr tycon ) 
418                       ASSERT2( length cons == tyConFamilySize tycon, ppr tycon )
419                       cons
420                     where
421                       cons = tyConDataConsIfAvailable tycon
422
423 tyConDataConsIfAvailable (AlgTyCon {dataCons = cons}) = cons    -- Empty for abstract types
424 tyConDataConsIfAvailable (TupleTyCon {dataCon = con}) = [con]
425 tyConDataConsIfAvailable other                        = []
426         -- You may think this last equation should fail,
427         -- but it's quite convenient to return no constructors for
428         -- a synonym; see for example the call in TcTyClsDecls.
429
430 tyConFamilySize  :: TyCon -> Int
431 tyConFamilySize (AlgTyCon {noOfDataCons = n}) = n
432 tyConFamilySize (TupleTyCon {})               = 1
433 #ifdef DEBUG
434 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
435 #endif
436
437 tyConSelIds :: TyCon -> [Id]
438 tyConSelIds (AlgTyCon {selIds = sels}) = sels
439 tyConSelIds other_tycon                = []
440 \end{code}
441
442 \begin{code}
443 tyConPrimRep :: TyCon -> PrimRep
444 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
445 tyConPrimRep _                                = PtrRep
446 \end{code}
447
448 \begin{code}
449 tyConTheta :: TyCon -> [PredType]
450 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
451 -- should ask about anything else
452 \end{code}
453
454 @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
455 each tyvar, if available.  See @calcAlgTyConArgVrcs@ for how this is
456 actually computed (in another file).
457
458 \begin{code}
459 tyConArgVrcs_maybe :: TyCon -> Maybe ArgVrcs
460
461 tyConArgVrcs_maybe (FunTyCon   {}                     ) = Just [(False,True),(True,False)]
462 tyConArgVrcs_maybe (AlgTyCon   {tyConArgVrcs = oi})     = Just oi
463 tyConArgVrcs_maybe (PrimTyCon  {tyConArgVrcs = oi})     = Just oi
464 tyConArgVrcs_maybe (TupleTyCon {tyConArity = arity   }) = Just (replicate arity (True,False))
465 tyConArgVrcs_maybe (SynTyCon   {tyConArgVrcs = oi })    = Just oi
466 tyConArgVrcs_maybe _                                    = Nothing
467 \end{code}
468
469 \begin{code}
470 getSynTyConDefn :: TyCon -> ([TyVar], Type)
471 getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
472 \end{code}
473
474 \begin{code}
475 maybeTyConSingleCon :: TyCon -> Maybe DataCon
476 maybeTyConSingleCon (AlgTyCon {dataCons = [c]})  = Just c
477 maybeTyConSingleCon (AlgTyCon {})                = Nothing
478 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
479 maybeTyConSingleCon (PrimTyCon {})               = Nothing
480 maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
481 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $
482                          ppr tc
483 \end{code}
484
485 \begin{code}
486 isClassTyCon :: TyCon -> Bool
487 isClassTyCon (AlgTyCon {algTyConClass = Just _}) = True
488 isClassTyCon other_tycon                         = False
489
490 tyConClass_maybe :: TyCon -> Maybe Class
491 tyConClass_maybe (AlgTyCon {algTyConClass = maybe_clas}) = maybe_clas
492 tyConClass_maybe ther_tycon                              = Nothing
493 \end{code}
494
495
496 %************************************************************************
497 %*                                                                      *
498 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
499 %*                                                                      *
500 %************************************************************************
501
502 @TyCon@s are compared by comparing their @Unique@s.
503
504 The strictness analyser needs @Ord@. It is a lexicographic order with
505 the property @(a<=b) || (b<=a)@.
506
507 \begin{code}
508 instance Eq TyCon where
509     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
510     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
511
512 instance Ord TyCon where
513     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
514     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
515     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
516     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
517     compare a b = getUnique a `compare` getUnique b
518
519 instance Uniquable TyCon where
520     getUnique tc = tyConUnique tc
521
522 instance Outputable TyCon where
523     ppr tc  = ppr (getName tc) 
524
525 instance NamedThing TyCon where
526     getName = tyConName
527 \end{code}
528
529
530 %************************************************************************
531 %*                                                                      *
532 \subsection{Kind constructors}
533 %*                                                                      *
534 %************************************************************************
535
536 @matchesTyCon tc1 tc2@ checks whether an appliation
537 (tc1 t1..tn) matches (tc2 t1..tn).  By "matches" we basically mean "equals",
538 except that at the kind level tc2 might have more boxity info than tc1.
539
540 \begin{code}
541 matchesTyCon :: TyCon   -- Expected (e.g. arg type of function)
542              -> TyCon   -- Inferred (e.g. type of actual arg to function)
543              -> Bool
544
545 matchesTyCon tc1 tc2 =  uniq1 == uniq2 || uniq1 == anyBoxConKey
546                      where
547                         uniq1 = tyConUnique tc1
548                         uniq2 = tyConUnique tc2
549 \end{code}
550
551
552