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