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