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