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 other                              = False
 149
 150 isSynTyCon (SynTyCon _ _ _ _ _ _) = True
 151 isSynTyCon _                      = False
 152 \end{code}
 153
 154 \begin{code}
 155 -- Special cases to avoid reconstructing lots of kinds
 156 kind1 = mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind
 157 kind2 = mkBoxedTypeKind `mkArrowKind` kind1
 158
 159 tyConKind :: TyCon -> Kind
 160 tyConKind FunTyCon                       = kind2
 161 tyConKind (DataTyCon _ _ kind _ _ _ _ _) = kind
 162 tyConKind (PrimTyCon _ _ kind)           = kind
 163 tyConKind (SynTyCon _ _ k _ _ _)         = k
 164
 165 tyConKind (TupleTyCon _ _ n)
 166   = mkArrow n
 167    where
 168     mkArrow 0 = mkBoxedTypeKind
 169     mkArrow 1 = kind1
 170     mkArrow 2 = kind2
 171     mkArrow n = mkBoxedTypeKind `mkArrowKind` mkArrow (n-1)
 172
 173 tyConKind (SpecTyCon tc tys)
 174   = spec (tyConKind tc) tys
 175    where
 176     spec kind []              = kind
 177     spec kind (Just _  : tys) = spec (resultKind kind) tys
 178     spec kind (Nothing : tys) =
 179       argKind kind `mkArrowKind` spec (resultKind kind) tys
 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
 301       tag_TyCon FunTyCon                    = ILIT(1)
 302       tag_TyCon (DataTyCon _ _ _ _ _ _ _ _) = ILIT(2)
 303       tag_TyCon (TupleTyCon _ _ _)          = ILIT(3)
 304       tag_TyCon (PrimTyCon  _ _ _)          = ILIT(4)
 305       tag_TyCon (SpecTyCon  _ _)            = ILIT(5)
 306       tag_TyCon (SynTyCon _ _ _ _ _ _)      = ILIT(6)
 307
 308 instance Eq TyCon where
 309     a == b = case (a `cmp` b) of { EQ_ -> True;   _ -> False }
 310     a /= b = case (a `cmp` b) of { EQ_ -> False;  _ -> True  }
 311
 312 instance Ord TyCon where
 313     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 314     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 315     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 316     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 317     _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 318
 319 instance Uniquable TyCon where
 320     uniqueOf (DataTyCon u _ _ _ _ _ _ _) = u
 321     uniqueOf (PrimTyCon u _ _)           = u
 322     uniqueOf (SynTyCon  u _ _ _ _ _)     = u
 323     uniqueOf tc@(SpecTyCon _ _)          = panic "uniqueOf:SpecTyCon"
 324     uniqueOf tc                          = uniqueOf (getName tc)
 325 \end{code}
 326
 327 \begin{code}
 328 instance NamedThing TyCon where
 329     getName (DataTyCon _ n _ _ _ _ _ _) = n
 330     getName (PrimTyCon _ n _)           = n
 331     getName (SpecTyCon tc _)            = getName tc
 332     getName (SynTyCon _ n _ _ _ _)      = n
 333     getName FunTyCon                    = mkFunTyConName
 334     getName (TupleTyCon _ n _)          = n
 335     getName tc                          = panic "TyCon.getName"
 336
 337 {- LATER:
 338     getName (SpecTyCon tc tys) = let (m,n) = moduleNamePair tc in
 339                              (m, n _APPEND_ specMaybeTysSuffix tys)
 340     getName     other_tc           = moduleNamePair (expectJust "tycon1" (getName other_tc))
 341     getName other                            = Nothing
 342 -}
 343 \end{code}