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