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