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