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