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