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