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( length cons == tyConFamilySize tycon, ppr tycon )
 418                       cons
 419                     where
 420                       cons = tyConDataConsIfAvailable tycon
 421
 422 tyConDataConsIfAvailable (AlgTyCon {dataCons = cons}) = cons    -- Empty for abstract types
 423 tyConDataConsIfAvailable (TupleTyCon {dataCon = con}) = [con]
 424 tyConDataConsIfAvailable other                        = []
 425         -- You may think this last equation should fail,
 426         -- but it's quite convenient to return no constructors for
 427         -- a synonym; see for example the call in TcTyClsDecls.
 428
 429 tyConFamilySize  :: TyCon -> Int
 430 tyConFamilySize (AlgTyCon {noOfDataCons = n}) = n
 431 tyConFamilySize (TupleTyCon {})               = 1
 432 #ifdef DEBUG
 433 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
 434 #endif
 435
 436 tyConSelIds :: TyCon -> [Id]
 437 tyConSelIds (AlgTyCon {selIds = sels}) = sels
 438 tyConSelIds other_tycon                = []
 439 \end{code}
 440
 441 \begin{code}
 442 tyConPrimRep :: TyCon -> PrimRep
 443 tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
 444 tyConPrimRep _                                = PtrRep
 445 \end{code}
 446
 447 \begin{code}
 448 tyConTheta :: TyCon -> [PredType]
 449 tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta
 450 -- should ask about anything else
 451 \end{code}
 452
 453 @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
 454 each tyvar, if available.  See @calcAlgTyConArgVrcs@ for how this is
 455 actually computed (in another file).
 456
 457 \begin{code}
 458 tyConArgVrcs_maybe :: TyCon -> Maybe ArgVrcs
 459
 460 tyConArgVrcs_maybe (FunTyCon   {}                     ) = Just [(False,True),(True,False)]
 461 tyConArgVrcs_maybe (AlgTyCon   {tyConArgVrcs = oi})     = Just oi
 462 tyConArgVrcs_maybe (PrimTyCon  {tyConArgVrcs = oi})     = Just oi
 463 tyConArgVrcs_maybe (TupleTyCon {tyConArity = arity   }) = Just (replicate arity (True,False))
 464 tyConArgVrcs_maybe (SynTyCon   {tyConArgVrcs = oi })    = Just oi
 465 tyConArgVrcs_maybe _                                    = Nothing
 466 \end{code}
 467
 468 \begin{code}
 469 getSynTyConDefn :: TyCon -> ([TyVar], Type)
 470 getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
 471 \end{code}
 472
 473 \begin{code}
 474 maybeTyConSingleCon :: TyCon -> Maybe DataCon
 475 maybeTyConSingleCon (AlgTyCon {dataCons = [c]})  = Just c
 476 maybeTyConSingleCon (AlgTyCon {})                = Nothing
 477 maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
 478 maybeTyConSingleCon (PrimTyCon {})               = Nothing
 479 maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
 480 maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $
 481                          ppr tc
 482 \end{code}
 483
 484 \begin{code}
 485 isClassTyCon :: TyCon -> Bool
 486 isClassTyCon (AlgTyCon {algTyConClass = Just _}) = True
 487 isClassTyCon other_tycon                         = False
 488
 489 tyConClass_maybe :: TyCon -> Maybe Class
 490 tyConClass_maybe (AlgTyCon {algTyConClass = maybe_clas}) = maybe_clas
 491 tyConClass_maybe ther_tycon                              = Nothing
 492 \end{code}
 493
 494
 495 %************************************************************************
 496 %*                                                                      *
 497 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 498 %*                                                                      *
 499 %************************************************************************
 500
 501 @TyCon@s are compared by comparing their @Unique@s.
 502
 503 The strictness analyser needs @Ord@. It is a lexicographic order with
 504 the property @(a<=b) || (b<=a)@.
 505
 506 \begin{code}
 507 instance Eq TyCon where
 508     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 509     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 510
 511 instance Ord TyCon where
 512     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 513     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 514     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 515     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 516     compare a b = getUnique a `compare` getUnique b
 517
 518 instance Uniquable TyCon where
 519     getUnique tc = tyConUnique tc
 520
 521 instance Outputable TyCon where
 522     ppr tc  = ppr (getName tc)
 523
 524 instance NamedThing TyCon where
 525     getName = tyConName
 526 \end{code}
 527
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection{Kind constructors}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 @matchesTyCon tc1 tc2@ checks whether an appliation
 536 (tc1 t1..tn) matches (tc2 t1..tn).  By "matches" we basically mean "equals",
 537 except that at the kind level tc2 might have more boxity info than tc1.
 538
 539 \begin{code}
 540 matchesTyCon :: TyCon   -- Expected (e.g. arg type of function)
 541              -> TyCon   -- Inferred (e.g. type of actual arg to function)
 542              -> Bool
 543
 544 matchesTyCon tc1 tc2 =  uniq1 == uniq2 || uniq1 == anyBoxConKey
 545                      where
 546                         uniq1 = tyConUnique tc1
 547                         uniq2 = tyConUnique tc2
 548 \end{code}
 549
 550
 551