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