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