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