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