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,
  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 isSynTyCon (SynTyCon _ _ _ _ _ _) = True
 152 isSynTyCon _                      = False
 153 \end{code}
 154
 155 \begin{code}
 156 -- Special cases to avoid reconstructing lots of kinds
 157 kind1 = mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind
 158 kind2 = mkBoxedTypeKind `mkArrowKind` kind1
 159
 160 tyConKind :: TyCon -> Kind
 161 tyConKind FunTyCon                       = kind2
 162 tyConKind (DataTyCon _ _ kind _ _ _ _ _) = kind
 163 tyConKind (PrimTyCon _ _ kind)           = kind
 164 tyConKind (SynTyCon _ _ k _ _ _)         = k
 165
 166 tyConKind (TupleTyCon _ _ n)
 167   = mkArrow n
 168    where
 169     mkArrow 0 = mkBoxedTypeKind
 170     mkArrow 1 = kind1
 171     mkArrow 2 = kind2
 172     mkArrow n = mkBoxedTypeKind `mkArrowKind` mkArrow (n-1)
 173
 174 tyConKind (SpecTyCon tc tys)
 175   = spec (tyConKind tc) tys
 176    where
 177     spec kind []              = kind
 178     spec kind (Just _  : tys) = spec (resultKind kind) tys
 179     spec kind (Nothing : tys) =
 180       argKind kind `mkArrowKind` spec (resultKind kind) tys
 181 \end{code}
 182
 183 \begin{code}
 184 tyConUnique :: TyCon -> Unique
 185 tyConUnique FunTyCon                       = funTyConKey
 186 tyConUnique (DataTyCon uniq _ _ _ _ _ _ _) = uniq
 187 tyConUnique (TupleTyCon uniq _ _)          = uniq
 188 tyConUnique (PrimTyCon uniq _ _)           = uniq
 189 tyConUnique (SynTyCon uniq _ _ _ _ _)      = uniq
 190 tyConUnique (SpecTyCon _ _ )               = panic "tyConUnique:SpecTyCon"
 191
 192 tyConArity :: TyCon -> Arity
 193 tyConArity FunTyCon                      = 2
 194 tyConArity (DataTyCon _ _ _ tvs _ _ _ _) = length tvs
 195 tyConArity (TupleTyCon _ _ arity)        = arity
 196 tyConArity (PrimTyCon _ _ _)             = 0    -- ??
 197 tyConArity (SpecTyCon _ _)               = 0
 198 tyConArity (SynTyCon _ _ _ arity _ _)    = arity
 199
 200 synTyConArity :: TyCon -> Maybe Arity -- Nothing <=> not a syn tycon
 201 synTyConArity (SynTyCon _ _ _ arity _ _) = Just arity
 202 synTyConArity _                          = Nothing
 203 \end{code}
 204
 205 \begin{code}
 206 tyConTyVars :: TyCon -> [TyVar]
 207 tyConTyVars FunTyCon                      = [alphaTyVar,betaTyVar]
 208 tyConTyVars (DataTyCon _ _ _ tvs _ _ _ _) = tvs
 209 tyConTyVars (TupleTyCon _ _ arity)        = take arity alphaTyVars
 210 tyConTyVars (SynTyCon _ _ _ _ tvs _)      = tvs
 211 tyConTyVars (PrimTyCon _ _ _)             = panic "tyConTyVars:PrimTyCon"
 212 tyConTyVars (SpecTyCon _ _ )              = panic "tyConTyVars:SpecTyCon"
 213 \end{code}
 214
 215 \begin{code}
 216 tyConDataCons :: TyCon -> [Id]
 217 tyConFamilySize  :: TyCon -> Int
 218
 219 tyConDataCons (DataTyCon _ _ _ _ _ data_cons _ _) = data_cons
 220 tyConDataCons (TupleTyCon _ _ a)                  = [mkTupleCon a]
 221 tyConDataCons other                               = []
 222         -- You may think this last equation should fail,
 223         -- but it's quite convenient to return no constructors for
 224         -- a synonym; see for example the call in TcTyClsDecls.
 225
 226 tyConFamilySize (DataTyCon _ _ _ _ _ data_cons _ _) = length data_cons
 227 tyConFamilySize (TupleTyCon _ _ _)                  = 1
 228 \end{code}
 229
 230 \begin{code}
 231 tyConDerivings :: TyCon -> [Class]
 232 tyConDerivings (DataTyCon _ _ _ _ _ _ derivs _) = derivs
 233 tyConDerivings other                            = []
 234 \end{code}
 235
 236 \begin{code}
 237 getSynTyConDefn :: TyCon -> ([TyVar], Type)
 238 getSynTyConDefn (SynTyCon _ _ _ _ tyvars ty) = (tyvars,ty)
 239 \end{code}
 240
 241 \begin{code}
 242 maybeTyConSingleCon :: TyCon -> Maybe Id
 243
 244 maybeTyConSingleCon (TupleTyCon _ _ arity)        = Just (mkTupleCon arity)
 245 maybeTyConSingleCon (DataTyCon _ _ _ _ _ [c] _ _) = Just c
 246 maybeTyConSingleCon (DataTyCon _ _ _ _ _ _   _ _) = Nothing
 247 maybeTyConSingleCon (PrimTyCon _ _ _)             = Nothing
 248 maybeTyConSingleCon (SpecTyCon tc tys)            = panic "maybeTyConSingleCon:SpecTyCon"
 249                                                   -- requires DataCons of TyCon
 250
 251 isEnumerationTyCon (TupleTyCon _ _ arity)
 252   = arity == 0
 253 isEnumerationTyCon (DataTyCon _ _ _ _ _ data_cons _ _)
 254   = not (null data_cons) && all is_nullary data_cons
 255   where
 256     is_nullary con = case (dataConSig con) of { (_,_, arg_tys, _) ->
 257                      null arg_tys }
 258 \end{code}
 259
 260 @derivedFor@ reports if we have an {\em obviously}-derived instance
 261 for the given class/tycon.  Of course, you might be deriving something
 262 because it a superclass of some other obviously-derived class --- this
 263 function doesn't deal with that.
 264
 265 ToDo: what about derivings for specialised tycons !!!
 266
 267 \begin{code}
 268 derivedFor :: Class -> TyCon -> Bool
 269 derivedFor clas (DataTyCon _ _ _ _ _ _ derivs _) = isIn "derivedFor" clas derivs
 270 derivedFor clas something_weird                  = False
 271 \end{code}
 272
 273 %************************************************************************
 274 %*                                                                      *
 275 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
 276 %*                                                                      *
 277 %************************************************************************
 278
 279 @TyCon@s are compared by comparing their @Unique@s.
 280
 281 The strictness analyser needs @Ord@. It is a lexicographic order with
 282 the property @(a<=b) || (b<=a)@.
 283
 284 \begin{code}
 285 instance Ord3 TyCon where
 286   cmp FunTyCon                    FunTyCon                    = EQ_
 287   cmp (DataTyCon a _ _ _ _ _ _ _) (DataTyCon b _ _ _ _ _ _ _) = a `cmp` b
 288   cmp (SynTyCon a _ _ _ _ _)      (SynTyCon b _ _ _ _ _)      = a `cmp` b
 289   cmp (TupleTyCon _ _ a)          (TupleTyCon _ _ b)          = a `cmp` b
 290   cmp (PrimTyCon a _ _)           (PrimTyCon b _ _)           = a `cmp` b
 291   cmp (SpecTyCon tc1 mtys1)       (SpecTyCon tc2 mtys2)
 292     = panic# "cmp on SpecTyCons" -- case (tc1 `cmp` tc2) of { EQ_ -> mtys1 `cmp` mtys2; xxx -> xxx }
 293
 294     -- now we *know* the tags are different, so...
 295   cmp other_1 other_2
 296     | tag1 _LT_ tag2 = LT_
 297     | otherwise      = GT_
 298     where
 299       tag1 = tag_TyCon other_1
 300       tag2 = tag_TyCon other_2
 301
 302       tag_TyCon FunTyCon                    = ILIT(1)
 303       tag_TyCon (DataTyCon _ _ _ _ _ _ _ _) = ILIT(2)
 304       tag_TyCon (TupleTyCon _ _ _)          = ILIT(3)
 305       tag_TyCon (PrimTyCon  _ _ _)          = ILIT(4)
 306       tag_TyCon (SpecTyCon  _ _)            = ILIT(5)
 307       tag_TyCon (SynTyCon _ _ _ _ _ _)      = ILIT(6)
 308
 309 instance Eq TyCon where
 310     a == b = case (a `cmp` b) of { EQ_ -> True;   _ -> False }
 311     a /= b = case (a `cmp` b) of { EQ_ -> False;  _ -> True  }
 312
 313 instance Ord TyCon where
 314     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 315     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 316     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 317     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 318     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 319
 320 instance Uniquable TyCon where
 321     uniqueOf (DataTyCon  u _ _ _ _ _ _ _) = u
 322     uniqueOf (TupleTyCon u _ _)           = u
 323     uniqueOf (PrimTyCon  u _ _)           = u
 324     uniqueOf (SynTyCon   u _ _ _ _ _)     = u
 325     uniqueOf tc@(SpecTyCon _ _)           = panic "uniqueOf:SpecTyCon"
 326     uniqueOf tc                           = uniqueOf (getName tc)
 327 \end{code}
 328
 329 \begin{code}
 330 instance NamedThing TyCon where
 331     getName (DataTyCon _ n _ _ _ _ _ _) = n
 332     getName (PrimTyCon _ n _)           = n
 333     getName (SpecTyCon tc _)            = getName tc
 334     getName (SynTyCon _ n _ _ _ _)      = n
 335     getName FunTyCon                    = mkFunTyConName
 336     getName (TupleTyCon _ n _)          = n
 337     getName tc                          = panic "TyCon.getName"
 338
 339 {- LATER:
 340     getName (SpecTyCon tc tys) = let (m,n) = moduleNamePair 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}