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