ghc/compiler/types/TyCon.lhs

   1
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[TyCon]{The @TyCon@ datatype}
   5
   6 \begin{code}
   7 module TyCon(
   8         TyCon,
   9
  10         Arity, NewOrData(..),
  11
  12         isFunTyCon, isPrimTyCon, isBoxedTyCon, isProductTyCon,
  13         isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon,
  14         isEnumerationTyCon, isTupleTyCon,
  15
  16         mkDataTyCon,
  17         mkFunTyCon,
  18         mkPrimTyCon,
  19         mkSpecTyCon,
  20         mkTupleTyCon,
  21
  22         mkSynTyCon,
  23
  24         tyConKind,
  25         tyConUnique,
  26         tyConTyVars,
  27         tyConDataCons,
  28         tyConFamilySize,
  29         tyConDerivings,
  30         tyConTheta,
  31         tyConPrimRep,
  32         tyConArity,
  33         tyConClass_maybe,
  34         getSynTyConDefn,
  35
  36         maybeTyConSingleCon
  37 ) where
  38
  39 #include "HsVersions.h"
  40
  41 import {-# SOURCE #-} Type  ( Type )
  42 import {-# SOURCE #-} Class ( Class )
  43 import {-# SOURCE #-} Id    ( Id, isNullaryDataCon, idType )
  44 import {-# SOURCE #-} TysWiredIn ( tupleCon )
  45
  46
  47 import BasicTypes       ( Arity, NewOrData(..), RecFlag(..) )
  48 import TyVar            ( GenTyVar, alphaTyVars, alphaTyVar, betaTyVar, TyVar )
  49 import Kind             ( Kind, mkBoxedTypeKind, mkTypeKind, mkUnboxedTypeKind,
  50                           mkArrowKind, resultKind, argKind
  51                         )
  52 import Maybes
  53 import Name             ( Name, nameUnique, mkWiredInTyConName, NamedThing(getName) )
  54 import Unique           ( Unique, funTyConKey, Uniquable(..) )
  55 import PrimRep          ( PrimRep(..), isFollowableRep )
  56 import PrelMods         ( pREL_GHC, pREL_TUP, pREL_BASE )
  57 import Lex              ( mkTupNameStr )
  58 import SrcLoc           ( SrcLoc, mkBuiltinSrcLoc )
  59 import Util             ( nOfThem, isIn )
  60 import Outputable
  61 \end{code}
  62
  63 \begin{code}
  64 data TyCon
  65   = FunTyCon            -- Kind = Type -> Type -> Type
  66
  67   | DataTyCon   Unique
  68                 Name
  69                 Kind
  70                 [TyVar]
  71                 [(Class,[Type])]        -- Its context
  72                 [Id{-DataCon-}] -- Its data constructors, with fully polymorphic types
  73                                 --      This list can be empty, when we import a data type abstractly,
  74                                 --      either (a) the interface is hand-written and doesn't give
  75                                 --                 the constructors, or
  76                                 --             (b) in a quest for fast compilation we don't import
  77                                 --                 the constructors
  78                 [Class]         -- Classes which have derived instances
  79                 (Maybe Class)   -- Nothing for ordinary types; Just c for the type constructor
  80                                 -- for dictionaries of class c.
  81                 NewOrData
  82                 RecFlag         -- Tells whether the data type is part of
  83                                 -- a mutually-recursive group or not
  84
  85   | TupleTyCon  Unique          -- cached
  86                 Name            -- again, we could do without this, but
  87                                 -- it makes life somewhat easier
  88                 Arity   -- just a special case of DataTyCon
  89                         -- Kind = BoxedTypeKind
  90                         --      -> ... (n times) ...
  91                         --      -> BoxedTypeKind
  92                         --      -> BoxedTypeKind
  93
  94   | PrimTyCon           -- Primitive types; cannot be defined in Haskell
  95         Unique          -- Always unpointed; hence never represented by a closure
  96         Name            -- Often represented by a bit-pattern for the thing
  97         Kind            -- itself (eg Int#), but sometimes by a pointer to
  98         Arity           -- the thing.
  99         PrimRep
 100
 101   | SpecTyCon           -- A specialised TyCon; eg (Arr# Int#), or (List Int#)
 102         TyCon
 103         [Maybe Type]    -- Specialising types
 104
 105         --      OLD STUFF ABOUT Array types.  Use SpecTyCon instead
 106         -- ([PrimRep] -> PrimRep) -- a heap-allocated object (eg ArrInt#).
 107         -- The primitive types Arr# and StablePtr# have
 108         -- parameters (hence arity /= 0); but the rest don't.
 109         -- Only arrays use the list in a non-trivial way.
 110         -- Length of that list must == arity.
 111
 112   | SynTyCon
 113         Unique
 114         Name
 115         Kind
 116         Arity
 117         [TyVar]         -- Argument type variables
 118         Type            -- Right-hand side, mentioning these type vars.
 119                         -- Acts as a template for the expansion when
 120                         -- the tycon is applied to some types.
 121 \end{code}
 122
 123 \begin{code}
 124 mkFunTyCon     = FunTyCon
 125 mkFunTyConName = mkWiredInTyConName funTyConKey pREL_GHC SLIT("->") FunTyCon
 126
 127 mkSpecTyCon  = SpecTyCon
 128 mkTupleTyCon = TupleTyCon
 129
 130 mkDataTyCon name = DataTyCon (nameUnique name) name
 131
 132 mkPrimTyCon name arity rep
 133   = PrimTyCon (nameUnique name) name (mk_kind arity) arity rep
 134   where
 135     mk_kind 0 | isFollowableRep rep = mkBoxedTypeKind   -- Represented by a GC-ish ptr
 136               | otherwise           = mkUnboxedTypeKind -- Represented by a non-ptr
 137     mk_kind n = mkTypeKind `mkArrowKind` mk_kind (n-1)
 138
 139 mkSynTyCon  name = SynTyCon  (nameUnique name) name
 140
 141 isFunTyCon FunTyCon = True
 142 isFunTyCon _ = False
 143
 144 isPrimTyCon (PrimTyCon _ _ _ _ _) = True
 145 isPrimTyCon _ = False
 146
 147 -- At present there are no unboxed non-primitive types, so
 148 -- isBoxedTyCon is just the negation of isPrimTyCon.
 149 isBoxedTyCon = not . isPrimTyCon
 150
 151 -- isAlgTyCon returns True for both @data@ and @newtype@
 152 isAlgTyCon (DataTyCon _ _ _ _ _ _ _ _ _ _) = True
 153 isAlgTyCon (TupleTyCon _ _ _)              = True
 154 isAlgTyCon other                           = False
 155
 156 -- isDataTyCon returns False for @newtype@.
 157 isDataTyCon (DataTyCon _ _ _ _ _ _ _ _ DataType _) = True
 158 isDataTyCon (TupleTyCon _ _ _)                     = True
 159 isDataTyCon other                                  = False
 160
 161 isNewTyCon (DataTyCon _ _ _ _ _ _ _ _ NewType _) = True
 162 isNewTyCon other                                 = False
 163
 164 -- A "product" tycon is non-recursive and has one constructor,
 165 -- whether DataType or NewType
 166 isProductTyCon (TupleTyCon _ _ _)                           = True
 167 isProductTyCon (DataTyCon _ _ _ _ _ [c] _ _ _ NonRecursive) = True
 168 isProductTyCon other                                        = False
 169
 170 isSynTyCon (SynTyCon _ _ _ _ _ _) = True
 171 isSynTyCon _                      = False
 172
 173 isEnumerationTyCon (TupleTyCon _ _ arity)
 174   = arity == 0
 175 isEnumerationTyCon (DataTyCon _ _ _ _ _ data_cons _ _ DataType _)
 176   = not (null data_cons) && all isNullaryDataCon data_cons
 177 isEnumerationTyCon other = False
 178
 179 isTupleTyCon (TupleTyCon _ _ arity) = arity >= 2    -- treat "0-tuple" specially
 180 isTupleTyCon (SpecTyCon tc tys)     = isTupleTyCon tc
 181 isTupleTyCon other                  = False
 182 \end{code}
 183
 184 \begin{code}
 185 -- Special cases to avoid reconstructing lots of kinds
 186 kind1 = mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind
 187 kind2 = mkBoxedTypeKind `mkArrowKind` kind1
 188
 189 tyConKind :: TyCon -> Kind
 190 tyConKind FunTyCon                           = kind2
 191 tyConKind (DataTyCon _ _ kind _ _ _ _ _ _ _) = kind
 192 tyConKind (PrimTyCon _ _ kind _ _)           = kind
 193 tyConKind (SynTyCon _ _ k _ _ _)             = k
 194
 195 tyConKind (TupleTyCon _ _ n)
 196   = mkArrow n
 197    where
 198     mkArrow 0 = mkBoxedTypeKind
 199     mkArrow 1 = kind1
 200     mkArrow 2 = kind2
 201     mkArrow n = mkBoxedTypeKind `mkArrowKind` mkArrow (n-1)
 202
 203 tyConKind (SpecTyCon tc tys)
 204   = spec (tyConKind tc) tys
 205    where
 206     spec kind []              = kind
 207     spec kind (Just _  : tys) = spec (resultKind kind) tys
 208     spec kind (Nothing : tys) =
 209       argKind kind `mkArrowKind` spec (resultKind kind) tys
 210 \end{code}
 211
 212 \begin{code}
 213 tyConUnique :: TyCon -> Unique
 214 tyConUnique FunTyCon                           = funTyConKey
 215 tyConUnique (DataTyCon uniq _ _ _ _ _ _ _ _ _) = uniq
 216 tyConUnique (TupleTyCon uniq _ _)              = uniq
 217 tyConUnique (PrimTyCon uniq _ _ _ _)           = uniq
 218 tyConUnique (SynTyCon uniq _ _ _ _ _)          = uniq
 219 tyConUnique (SpecTyCon _ _ )                   = panic "tyConUnique:SpecTyCon"
 220
 221 tyConArity :: TyCon -> Arity
 222 tyConArity FunTyCon                             = 2
 223 tyConArity (DataTyCon _ _ _ tyvars _ _ _ _ _ _) = length tyvars
 224 tyConArity (TupleTyCon _ _ arity)               = arity
 225 tyConArity (PrimTyCon _ _ _ arity _)            = arity
 226 tyConArity (SynTyCon _ _ _ arity _ _)           = arity
 227 tyConArity (SpecTyCon _ _ )                     = panic "tyConArity:SpecTyCon"
 228 \end{code}
 229
 230 \begin{code}
 231 tyConTyVars :: TyCon -> [TyVar]
 232 tyConTyVars FunTyCon                          = [alphaTyVar,betaTyVar]
 233 tyConTyVars (DataTyCon _ _ _ tvs _ _ _ _ _ _) = tvs
 234 tyConTyVars (TupleTyCon _ _ arity)            = take arity alphaTyVars
 235 tyConTyVars (SynTyCon _ _ _ _ tvs _)          = tvs
 236 #ifdef DEBUG
 237 tyConTyVars (PrimTyCon _ _ _ _ _)         = panic "tyConTyVars:PrimTyCon"
 238 tyConTyVars (SpecTyCon _ _ )              = panic "tyConTyVars:SpecTyCon"
 239 #endif
 240 \end{code}
 241
 242 \begin{code}
 243 tyConDataCons :: TyCon -> [Id]
 244 tyConFamilySize  :: TyCon -> Int
 245
 246 tyConDataCons (DataTyCon _ _ _ _ _ data_cons _ _ _ _) = data_cons
 247 tyConDataCons (TupleTyCon _ _ a)                      = [tupleCon a]
 248 tyConDataCons other                                   = []
 249         -- You may think this last equation should fail,
 250         -- but it's quite convenient to return no constructors for
 251         -- a synonym; see for example the call in TcTyClsDecls.
 252
 253 tyConFamilySize (DataTyCon _ _ _ _ _ data_cons _ _ _ _) = length data_cons
 254 tyConFamilySize (TupleTyCon _ _ _)                      = 1
 255 #ifdef DEBUG
 256 --tyConFamilySize other = pprPanic "tyConFamilySize:" (pprTyCon other)
 257 #endif
 258
 259 tyConPrimRep :: TyCon -> PrimRep
 260 tyConPrimRep (PrimTyCon _ __  _ rep) = rep
 261 tyConPrimRep _                       = PtrRep
 262 \end{code}
 263
 264 \begin{code}
 265 tyConDerivings :: TyCon -> [Class]
 266 tyConDerivings (DataTyCon _ _ _ _ _ _ derivs _ _ _) = derivs
 267 tyConDerivings other                                = []
 268 \end{code}
 269
 270 \begin{code}
 271 tyConTheta :: TyCon -> [(Class, [Type])]
 272 tyConTheta (DataTyCon _ _ _ _ theta _ _ _ _ _) = theta
 273 tyConTheta (TupleTyCon _ _ _)                  = []
 274 -- should ask about anything else
 275 \end{code}
 276
 277 \begin{code}
 278 getSynTyConDefn :: TyCon -> ([TyVar], Type)
 279 getSynTyConDefn (SynTyCon _ _ _ _ tyvars ty) = (tyvars,ty)
 280 \end{code}
 281
 282 \begin{code}
 283 maybeTyConSingleCon :: TyCon -> Maybe Id
 284
 285 maybeTyConSingleCon (TupleTyCon _ _ arity)            = Just (tupleCon arity)
 286 maybeTyConSingleCon (DataTyCon _ _ _ _ _ [c] _ _ _ _) = Just c
 287 maybeTyConSingleCon (DataTyCon _ _ _ _ _ _   _ _ _ _) = Nothing
 288 maybeTyConSingleCon (PrimTyCon _ _ _ _ _)             = Nothing
 289 maybeTyConSingleCon (SpecTyCon tc tys)                = panic "maybeTyConSingleCon:SpecTyCon"
 290                                                   -- requires DataCons of TyCon
 291 \end{code}
 292
 293 \begin{code}
 294 tyConClass_maybe :: TyCon -> Maybe Class
 295 tyConClass_maybe (DataTyCon _ _ _ _ _ _ _ maybe_cls _ _) = maybe_cls
 296 tyConClass_maybe other_tycon                             = Nothing
 297 \end{code}
 298
 299 @derivedFor@ reports if we have an {\em obviously}-derived instance
 300 for the given class/tycon.  Of course, you might be deriving something
 301 because it a superclass of some other obviously-derived class --- this
 302 function doesn't deal with that.
 303
 304 ToDo: what about derivings for specialised tycons !!!
 305
 306 %************************************************************************
 307 %*                                                                      *
 308 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 309 %*                                                                      *
 310 %************************************************************************
 311
 312 @TyCon@s are compared by comparing their @Unique@s.
 313
 314 The strictness analyser needs @Ord@. It is a lexicographic order with
 315 the property @(a<=b) || (b<=a)@.
 316
 317 \begin{code}
 318 instance Eq TyCon where
 319     a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
 320     a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
 321
 322 instance Ord TyCon where
 323     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 324     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 325     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 326     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 327     compare a b = uniqueOf a `compare` uniqueOf b
 328
 329 instance Uniquable TyCon where
 330     uniqueOf tc = tyConUnique tc
 331 \end{code}
 332
 333 \begin{code}
 334 instance NamedThing TyCon where
 335     getName (DataTyCon _ n _ _ _ _ _ _ _ _) = n
 336     getName (PrimTyCon _ n _ _ _)           = n
 337     getName (SpecTyCon tc _)                = getName tc
 338     getName (SynTyCon _ n _ _ _ _)          = n
 339     getName FunTyCon                        = mkFunTyConName
 340     getName (TupleTyCon _ n _)              = n
 341
 342 {- LATER:
 343     getName (SpecTyCon tc tys) = let (OrigName m n) = origName "????" tc in
 344                              (m, n _APPEND_ specMaybeTysSuffix tys)
 345     getName     other_tc           = moduleNamePair (expectJust "tycon1" (getName other_tc))
 346     getName other                            = Nothing
 347 -}
 348 \end{code}