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