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