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