ghc/compiler/types/TypeRep.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[TypeRep]{Type - friends' interface}
   5
   6 \begin{code}
   7 module TypeRep (
   8         Type(..), TyNote(..), UsageAnn(..),             -- Representation visible to friends
   9         Kind, TyVarSubst,
  10
  11         superKind, superBoxity,                         -- :: SuperKind
  12
  13         boxedKind,                                      -- :: Kind :: BX
  14         anyBoxKind,                                     -- :: Kind :: BX
  15         typeCon,                                        -- :: KindCon :: BX -> KX
  16         anyBoxCon,                                      -- :: KindCon :: BX
  17
  18         boxedTypeKind, unboxedTypeKind, openTypeKind,   -- Kind :: superKind
  19
  20         mkArrowKind, mkArrowKinds,
  21
  22         funTyCon
  23     ) where
  24
  25 #include "HsVersions.h"
  26
  27 -- friends:
  28 import Var      ( TyVar, UVar )
  29 import VarEnv
  30 import VarSet
  31
  32 import Name     ( Provenance(..), ExportFlag(..),
  33                   mkWiredInTyConName, mkGlobalName, mkKindOccFS, tcName,
  34                 )
  35 import TyCon    ( TyCon, KindCon,
  36                   mkFunTyCon, mkKindCon, mkSuperKindCon,
  37                 )
  38
  39 -- others
  40 import SrcLoc           ( mkBuiltinSrcLoc )
  41 import PrelMods         ( pREL_GHC )
  42 import Unique           -- quite a few *Keys
  43 import Util             ( thenCmp )
  44 \end{code}
  45
  46 %************************************************************************
  47 %*                                                                      *
  48 \subsection{Type Classifications}
  49 %*                                                                      *
  50 %************************************************************************
  51
  52 A type is
  53
  54         *unboxed*       iff its representation is other than a pointer
  55                         Unboxed types cannot instantiate a type variable.
  56                         Unboxed types are always unlifted.
  57
  58         *lifted*        A type is lifted iff it has bottom as an element.
  59                         Closures always have lifted types:  i.e. any
  60                         let-bound identifier in Core must have a lifted
  61                         type.  Operationally, a lifted object is one that
  62                         can be entered.
  63                         (NOTE: previously "pointed").
  64
  65         *algebraic*     A type with one or more constructors, whether declared
  66                         with "data" or "newtype".
  67                         An algebraic type is one that can be deconstructed
  68                         with a case expression.
  69                         *NOT* the same as lifted types,  because we also
  70                         include unboxed tuples in this classification.
  71
  72         *data*          A type declared with "data".  Also boxed tuples.
  73
  74         *primitive*     iff it is a built-in type that can't be expressed
  75                         in Haskell.
  76
  77 Currently, all primitive types are unlifted, but that's not necessarily
  78 the case.  (E.g. Int could be primitive.)
  79
  80 Some primitive types are unboxed, such as Int#, whereas some are boxed
  81 but unlifted (such as ByteArray#).  The only primitive types that we
  82 classify as algebraic are the unboxed tuples.
  83
  84 examples of type classifications:
  85
  86 Type            primitive       boxed           lifted          algebraic
  87 -----------------------------------------------------------------------------
  88 Int#,           Yes             No              No              No
  89 ByteArray#      Yes             Yes             No              No
  90 (# a, b #)      Yes             No              No              Yes
  91 (  a, b  )      No              Yes             Yes             Yes
  92 [a]             No              Yes             Yes             Yes
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection{The data type}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100
 101 \begin{code}
 102 type SuperKind = Type
 103 type Kind      = Type
 104
 105 type TyVarSubst = TyVarEnv Type
 106
 107 data Type
 108   = TyVarTy TyVar
 109
 110   | AppTy
 111         Type            -- Function is *not* a TyConApp
 112         Type
 113
 114   | TyConApp                    -- Application of a TyCon
 115         TyCon                   -- *Invariant* saturated appliations of FunTyCon and
 116                                 --      synonyms have their own constructors, below.
 117         [Type]          -- Might not be saturated.
 118
 119   | FunTy                       -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
 120         Type
 121         Type
 122
 123   | NoteTy                      -- Saturated application of a type synonym
 124         TyNote
 125         Type            -- The expanded version
 126
 127   | ForAllTy
 128         TyVar
 129         Type            -- TypeKind
 130
 131 data TyNote
 132   = SynNote Type        -- The unexpanded version of the type synonym; always a TyConApp
 133   | FTVNote TyVarSet    -- The free type variables of the noted expression
 134   | UsgNote UsageAnn    -- The usage annotation at this node
 135   | UsgForAll UVar      -- Annotation variable binder
 136
 137 data UsageAnn
 138   = UsOnce              -- Used at most once
 139   | UsMany              -- Used possibly many times (no info; this annotation can be omitted)
 140   | UsVar    UVar       -- Annotation is variable (unbound OK only inside analysis)
 141 \end{code}
 142
 143
 144 %************************************************************************
 145 %*                                                                      *
 146 \subsection{Kinds}
 147 %*                                                                      *
 148 %************************************************************************
 149
 150 Kinds
 151 ~~~~~
 152 k::K = Type bx
 153      | k -> k
 154      | kv
 155
 156 kv :: KX is a kind variable
 157
 158 Type :: BX -> KX
 159
 160 bx::BX = Boxed
 161       |  Unboxed
 162       |  AnyBox         -- Used *only* for special built-in things
 163                         -- like error :: forall (a::*?). String -> a
 164                         -- Here, the 'a' can be instantiated to a boxed or
 165                         -- unboxed type.
 166       |  bv
 167
 168 bxv :: BX is a boxity variable
 169
 170 sk = KX         -- A kind
 171    | BX         -- A boxity
 172    | sk -> sk   -- In ptic (BX -> KX)
 173
 174 \begin{code}
 175 mk_kind_name key str = mkGlobalName key pREL_GHC (mkKindOccFS tcName str)
 176                                     (LocalDef mkBuiltinSrcLoc NotExported)
 177         -- mk_kind_name is a bit of a hack
 178         -- The LocalDef means that we print the name without
 179         -- a qualifier, which is what we want for these kinds.
 180         -- It's used for both Kinds and Boxities
 181 \end{code}
 182
 183 Define KX, BX.
 184
 185 \begin{code}
 186 superKind :: SuperKind          -- KX, the type of all kinds
 187 superKindName = mk_kind_name kindConKey SLIT("KX")
 188 superKind = TyConApp (mkSuperKindCon superKindName) []
 189
 190 superBoxity :: SuperKind                -- BX, the type of all boxities
 191 superBoxityName = mk_kind_name boxityConKey SLIT("BX")
 192 superBoxity = TyConApp (mkSuperKindCon superBoxityName) []
 193 \end{code}
 194
 195 Define Boxed, Unboxed, AnyBox
 196
 197 \begin{code}
 198 boxedKind, unboxedKind, anyBoxKind :: Kind      -- Of superkind superBoxity
 199
 200 boxedConName = mk_kind_name boxedConKey SLIT("*")
 201 boxedKind    = TyConApp (mkKindCon boxedConName superBoxity) []
 202
 203 unboxedConName = mk_kind_name unboxedConKey SLIT("#")
 204 unboxedKind    = TyConApp (mkKindCon unboxedConName superBoxity) []
 205
 206 anyBoxConName = mk_kind_name anyBoxConKey SLIT("?")
 207 anyBoxCon     = mkKindCon anyBoxConName superBoxity     -- A kind of wild card
 208 anyBoxKind    = TyConApp anyBoxCon []
 209 \end{code}
 210
 211 Define Type
 212
 213 \begin{code}
 214 typeCon :: KindCon
 215 typeConName = mk_kind_name typeConKey SLIT("Type")
 216 typeCon     = mkKindCon typeConName (superBoxity `FunTy` superKind)
 217 \end{code}
 218
 219 Define (Type Boxed), (Type Unboxed), (Type AnyBox)
 220
 221 \begin{code}
 222 boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind
 223 boxedTypeKind   = TyConApp typeCon [boxedKind]
 224 unboxedTypeKind = TyConApp typeCon [unboxedKind]
 225 openTypeKind    = TyConApp typeCon [anyBoxKind]
 226
 227 mkArrowKind :: Kind -> Kind -> Kind
 228 mkArrowKind k1 k2 = k1 `FunTy` k2
 229
 230 mkArrowKinds :: [Kind] -> Kind -> Kind
 231 mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
 232 \end{code}
 233
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsection{Wired-in type constructors
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 We define a few wired-in type constructors here to avoid module knots
 242
 243 \begin{code}
 244 funTyConName = mkWiredInTyConName funTyConKey pREL_GHC SLIT("(->)") funTyCon
 245 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
 246 \end{code}
 247
 248
 249 %************************************************************************
 250 %*                                                                      *
 251 \subsection{Equality on types}
 252 %*                                                                      *
 253 %************************************************************************
 254
 255 For the moment at least, type comparisons don't work if
 256 there are embedded for-alls.
 257
 258 \begin{code}
 259 instance Eq Type where
 260   ty1 == ty2 = case ty1 `cmpTy` ty2 of { EQ -> True; other -> False }
 261
 262 instance Ord Type where
 263   compare ty1 ty2 = cmpTy ty1 ty2
 264
 265 cmpTy :: Type -> Type -> Ordering
 266 cmpTy ty1 ty2
 267   = cmp emptyVarEnv ty1 ty2
 268   where
 269   -- The "env" maps type variables in ty1 to type variables in ty2
 270   -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
 271   -- we in effect substitute tv2 for tv1 in t1 before continuing
 272     lookup env tv1 = case lookupVarEnv env tv1 of
 273                           Just tv2 -> tv2
 274                           Nothing  -> tv1
 275
 276     -- Get rid of NoteTy
 277     cmp env (NoteTy _ ty1) ty2 = cmp env ty1 ty2
 278     cmp env ty1 (NoteTy _ ty2) = cmp env ty1 ty2
 279
 280     -- Deal with equal constructors
 281     cmp env (TyVarTy tv1) (TyVarTy tv2) = lookup env tv1 `compare` tv2
 282     cmp env (AppTy f1 a1) (AppTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
 283     cmp env (FunTy f1 a1) (FunTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
 284     cmp env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmps env tys1 tys2)
 285     cmp env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmp (extendVarEnv env tv1 tv2) t1 t2
 286
 287     -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy
 288     cmp env (AppTy _ _) (TyVarTy _) = GT
 289
 290     cmp env (FunTy _ _) (TyVarTy _) = GT
 291     cmp env (FunTy _ _) (AppTy _ _) = GT
 292
 293     cmp env (TyConApp _ _) (TyVarTy _) = GT
 294     cmp env (TyConApp _ _) (AppTy _ _) = GT
 295     cmp env (TyConApp _ _) (FunTy _ _) = GT
 296
 297     cmp env (ForAllTy _ _) other       = GT
 298
 299     cmp env _ _                        = LT
 300
 301     cmps env []     [] = EQ
 302     cmps env (t:ts) [] = GT
 303     cmps env [] (t:ts) = LT
 304     cmps env (t1:t1s) (t2:t2s) = cmp env t1 t2 `thenCmp` cmps env t1s t2s
 305 \end{code}
 306