ghc/compiler/types/Type.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Type]{Type}
   5
   6 \begin{code}
   7 module Type (
   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, hasMoreBoxityInfo,
  21
  22         funTyCon,
  23
  24         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
  25
  26         mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
  27
  28         mkFunTy, mkFunTys, splitFunTy_maybe, splitFunTys, splitFunTysN,
  29         funResultTy, funArgTy,
  30         zipFunTys,
  31
  32         mkTyConApp, mkTyConTy, splitTyConApp_maybe,
  33         splitAlgTyConApp_maybe, splitAlgTyConApp,
  34         mkDictTy, splitDictTy_maybe, isDictTy,
  35
  36         mkSynTy, isSynTy, deNoteType, repType, splitNewType_maybe,
  37
  38         mkUsgTy, isUsgTy{- dont use -}, isNotUsgTy, splitUsgTy, unUsgTy, tyUsg,
  39
  40         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
  41         isForAllTy, applyTy, applyTys, mkPiType,
  42
  43         TauType, RhoType, SigmaType, ThetaType,
  44         isTauTy,
  45         mkRhoTy, splitRhoTy,
  46         mkSigmaTy, splitSigmaTy,
  47
  48         -- Lifting and boxity
  49         isUnLiftedType, isUnboxedType, isUnboxedTupleType, isAlgType, isDataType, isNewType,
  50         typePrimRep,
  51
  52         -- Free variables
  53         tyVarsOfType, tyVarsOfTypes, namesOfType, typeKind,
  54         addFreeTyVars,
  55
  56         -- Tidying up for printing
  57         tidyType,     tidyTypes,
  58         tidyOpenType, tidyOpenTypes,
  59         tidyTyVar,    tidyTyVars,
  60         tidyTopType,
  61
  62         -- Seq
  63         seqType, seqTypes
  64
  65     ) where
  66
  67 #include "HsVersions.h"
  68
  69 import {-# SOURCE #-}   DataCon( DataCon, dataConType )
  70 import {-# SOURCE #-}   PprType( pprType )      -- Only called in debug messages
  71 import {-# SOURCE #-}   Subst  ( mkTyVarSubst, substTy )
  72
  73 -- friends:
  74 import Var      ( Id, TyVar, IdOrTyVar, UVar,
  75                   tyVarKind, tyVarName, isId, idType, setTyVarName, setVarOcc
  76                 )
  77 import VarEnv
  78 import VarSet
  79
  80 import Name     ( NamedThing(..), Provenance(..), ExportFlag(..),
  81                   mkWiredInTyConName, mkGlobalName, mkLocalName, mkKindOccFS, tcName,
  82                   tidyOccName, TidyOccEnv
  83                 )
  84 import NameSet
  85 import Class    ( classTyCon, Class )
  86 import TyCon    ( TyCon, KindCon,
  87                   mkFunTyCon, mkKindCon, mkSuperKindCon,
  88                   matchesTyCon, isUnboxedTupleTyCon, isUnLiftedTyCon,
  89                   isFunTyCon, isDataTyCon, isNewTyCon,
  90                   isAlgTyCon, isSynTyCon, tyConArity,
  91                   tyConKind, tyConDataCons, getSynTyConDefn,
  92                   tyConPrimRep, tyConClass_maybe
  93                 )
  94
  95 -- others
  96 import BasicTypes       ( Unused )
  97 import SrcLoc           ( mkBuiltinSrcLoc, noSrcLoc )
  98 import PrelMods         ( pREL_GHC )
  99 import Maybes           ( maybeToBool )
 100 import PrimRep          ( PrimRep(..), isFollowableRep )
 101 import Unique           -- quite a few *Keys
 102 import Util             ( thenCmp, mapAccumL, seqList, ($!) )
 103 import Outputable
 104 import UniqSet          ( sizeUniqSet )         -- Should come via VarSet
 105 \end{code}
 106
 107 %************************************************************************
 108 %*                                                                      *
 109 \subsection{Type Classifications}
 110 %*                                                                      *
 111 %************************************************************************
 112
 113 A type is
 114
 115         *unboxed*       iff its representation is other than a pointer
 116                         Unboxed types cannot instantiate a type variable.
 117                         Unboxed types are always unlifted.
 118
 119         *lifted*        A type is lifted iff it has bottom as an element.
 120                         Closures always have lifted types:  i.e. any
 121                         let-bound identifier in Core must have a lifted
 122                         type.  Operationally, a lifted object is one that
 123                         can be entered.
 124                         (NOTE: previously "pointed").
 125
 126         *algebraic*     A type with one or more constructors, whether declared
 127                         with "data" or "newtype".
 128                         An algebraic type is one that can be deconstructed
 129                         with a case expression.
 130                         *NOT* the same as lifted types,  because we also
 131                         include unboxed tuples in this classification.
 132
 133         *data*          A type declared with "data".  Also boxed tuples.
 134
 135         *primitive*     iff it is a built-in type that can't be expressed
 136                         in Haskell.
 137
 138 Currently, all primitive types are unlifted, but that's not necessarily
 139 the case.  (E.g. Int could be primitive.)
 140
 141 Some primitive types are unboxed, such as Int#, whereas some are boxed
 142 but unlifted (such as ByteArray#).  The only primitive types that we
 143 classify as algebraic are the unboxed tuples.
 144
 145 examples of type classifications:
 146
 147 Type            primitive       boxed           lifted          algebraic
 148 -----------------------------------------------------------------------------
 149 Int#,           Yes             No              No              No
 150 ByteArray#      Yes             Yes             No              No
 151 (# a, b #)      Yes             No              No              Yes
 152 (  a, b  )      No              Yes             Yes             Yes
 153 [a]             No              Yes             Yes             Yes
 154
 155 %************************************************************************
 156 %*                                                                      *
 157 \subsection{The data type}
 158 %*                                                                      *
 159 %************************************************************************
 160
 161
 162 \begin{code}
 163 type SuperKind = Type
 164 type Kind      = Type
 165
 166 type TyVarSubst = TyVarEnv Type
 167
 168 data Type
 169   = TyVarTy TyVar
 170
 171   | AppTy
 172         Type            -- Function is *not* a TyConApp
 173         Type
 174
 175   | TyConApp                    -- Application of a TyCon
 176         TyCon                   -- *Invariant* saturated appliations of FunTyCon and
 177                                 --      synonyms have their own constructors, below.
 178         [Type]          -- Might not be saturated.
 179
 180   | FunTy                       -- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
 181         Type
 182         Type
 183
 184   | NoteTy                      -- Saturated application of a type synonym
 185         TyNote
 186         Type            -- The expanded version
 187
 188   | ForAllTy
 189         TyVar
 190         Type            -- TypeKind
 191
 192 data TyNote
 193   = SynNote Type        -- The unexpanded version of the type synonym; always a TyConApp
 194   | FTVNote TyVarSet    -- The free type variables of the noted expression
 195   | UsgNote UsageAnn    -- The usage annotation at this node
 196
 197 data UsageAnn
 198   = UsOnce              -- Used at most once
 199   | UsMany              -- Used possibly many times (no info; this annotation can be omitted)
 200   | UsVar UVar          -- Annotation is variable (should only happen inside analysis)
 201 \end{code}
 202
 203
 204 %************************************************************************
 205 %*                                                                      *
 206 \subsection{Kinds}
 207 %*                                                                      *
 208 %************************************************************************
 209
 210 Kinds
 211 ~~~~~
 212 k::K = Type bx
 213      | k -> k
 214      | kv
 215
 216 kv :: KX is a kind variable
 217
 218 Type :: BX -> KX
 219
 220 bx::BX = Boxed
 221       |  Unboxed
 222       |  AnyBox         -- Used *only* for special built-in things
 223                         -- like error :: forall (a::*?). String -> a
 224                         -- Here, the 'a' can be instantiated to a boxed or
 225                         -- unboxed type.
 226       |  bv
 227
 228 bxv :: BX is a boxity variable
 229
 230 sk = KX         -- A kind
 231    | BX         -- A boxity
 232    | sk -> sk   -- In ptic (BX -> KX)
 233
 234 \begin{code}
 235 mk_kind_name key str = mkGlobalName key pREL_GHC (mkKindOccFS tcName str)
 236                                     (LocalDef mkBuiltinSrcLoc NotExported)
 237         -- mk_kind_name is a bit of a hack
 238         -- The LocalDef means that we print the name without
 239         -- a qualifier, which is what we want for these kinds.
 240         -- It's used for both Kinds and Boxities
 241 \end{code}
 242
 243 Define KX, BX.
 244
 245 \begin{code}
 246 superKind :: SuperKind          -- KX, the type of all kinds
 247 superKindName = mk_kind_name kindConKey SLIT("KX")
 248 superKind = TyConApp (mkSuperKindCon superKindName) []
 249
 250 superBoxity :: SuperKind                -- BX, the type of all boxities
 251 superBoxityName = mk_kind_name boxityConKey SLIT("BX")
 252 superBoxity = TyConApp (mkSuperKindCon superBoxityName) []
 253 \end{code}
 254
 255 Define Boxed, Unboxed, AnyBox
 256
 257 \begin{code}
 258 boxedKind, unboxedKind, anyBoxKind :: Kind      -- Of superkind superBoxity
 259
 260 boxedConName = mk_kind_name boxedConKey SLIT("*")
 261 boxedKind    = TyConApp (mkKindCon boxedConName superBoxity) []
 262
 263 unboxedConName = mk_kind_name unboxedConKey SLIT("#")
 264 unboxedKind    = TyConApp (mkKindCon unboxedConName superBoxity) []
 265
 266 anyBoxConName = mk_kind_name anyBoxConKey SLIT("?")
 267 anyBoxCon     = mkKindCon anyBoxConName superBoxity     -- A kind of wild card
 268 anyBoxKind    = TyConApp anyBoxCon []
 269 \end{code}
 270
 271 Define Type
 272
 273 \begin{code}
 274 typeCon :: KindCon
 275 typeConName = mk_kind_name typeConKey SLIT("Type")
 276 typeCon     = mkKindCon typeConName (superBoxity `FunTy` superKind)
 277 \end{code}
 278
 279 Define (Type Boxed), (Type Unboxed), (Type AnyBox)
 280
 281 \begin{code}
 282 boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind
 283 boxedTypeKind   = TyConApp typeCon [boxedKind]
 284 unboxedTypeKind = TyConApp typeCon [unboxedKind]
 285 openTypeKind    = TyConApp typeCon [anyBoxKind]
 286
 287 mkArrowKind :: Kind -> Kind -> Kind
 288 mkArrowKind k1 k2 = k1 `FunTy` k2
 289
 290 mkArrowKinds :: [Kind] -> Kind -> Kind
 291 mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
 292 \end{code}
 293
 294 \begin{code}
 295 hasMoreBoxityInfo :: Kind -> Kind -> Bool
 296 hasMoreBoxityInfo k1 k2
 297   | k2 == openTypeKind = ASSERT( is_type_kind k1) True
 298   | otherwise          = k1 == k2
 299   where
 300         -- Returns true for things of form (Type x)
 301     is_type_kind k = case splitTyConApp_maybe k of
 302                         Just (tc,[_]) -> tc == typeCon
 303                         Nothing       -> False
 304 \end{code}
 305
 306
 307 %************************************************************************
 308 %*                                                                      *
 309 \subsection{Wired-in type constructors
 310 %*                                                                      *
 311 %************************************************************************
 312
 313 We define a few wired-in type constructors here to avoid module knots
 314
 315 \begin{code}
 316 funTyConName = mkWiredInTyConName funTyConKey pREL_GHC SLIT("(->)") funTyCon
 317 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
 318 \end{code}
 319
 320
 321
 322 %************************************************************************
 323 %*                                                                      *
 324 \subsection{Constructor-specific functions}
 325 %*                                                                      *
 326 %************************************************************************
 327
 328
 329 ---------------------------------------------------------------------
 330                                 TyVarTy
 331                                 ~~~~~~~
 332 \begin{code}
 333 mkTyVarTy  :: TyVar   -> Type
 334 mkTyVarTy  = TyVarTy
 335
 336 mkTyVarTys :: [TyVar] -> [Type]
 337 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 338
 339 getTyVar :: String -> Type -> TyVar
 340 getTyVar msg (TyVarTy tv) = tv
 341 getTyVar msg (NoteTy _ t) = getTyVar msg t
 342 getTyVar msg other        = panic ("getTyVar: " ++ msg)
 343
 344 getTyVar_maybe :: Type -> Maybe TyVar
 345 getTyVar_maybe (TyVarTy tv) = Just tv
 346 getTyVar_maybe (NoteTy _ t) = getTyVar_maybe t
 347 getTyVar_maybe other        = Nothing
 348
 349 isTyVarTy :: Type -> Bool
 350 isTyVarTy (TyVarTy tv)  = True
 351 isTyVarTy (NoteTy _ ty) = isTyVarTy ty
 352 isTyVarTy other         = False
 353 \end{code}
 354
 355
 356 ---------------------------------------------------------------------
 357                                 AppTy
 358                                 ~~~~~
 359 We need to be pretty careful with AppTy to make sure we obey the
 360 invariant that a TyConApp is always visibly so.  mkAppTy maintains the
 361 invariant: use it.
 362
 363 \begin{code}
 364 mkAppTy orig_ty1 orig_ty2 = ASSERT2( isNotUsgTy orig_ty1 && isNotUsgTy orig_ty2, pprType orig_ty1 <+> text "to" <+> pprType orig_ty2 )
 365                             mk_app orig_ty1
 366   where
 367     mk_app (NoteTy _ ty1)    = mk_app ty1
 368     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
 369     mk_app ty1               = AppTy orig_ty1 orig_ty2
 370
 371 mkAppTys :: Type -> [Type] -> Type
 372 mkAppTys orig_ty1 []        = orig_ty1
 373         -- This check for an empty list of type arguments
 374         -- avoids the needless of a type synonym constructor.
 375         -- For example: mkAppTys Rational []
 376         --   returns to (Ratio Integer), which has needlessly lost
 377         --   the Rational part.
 378 mkAppTys orig_ty1 orig_tys2 = ASSERT2( isNotUsgTy orig_ty1, pprType orig_ty1 )
 379                               mk_app orig_ty1
 380   where
 381     mk_app (NoteTy _ ty1)    = mk_app ty1
 382     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
 383     mk_app ty1               = ASSERT2( all isNotUsgTy orig_tys2, pprType orig_ty1 <+> text "to" <+> hsep (map pprType orig_tys2) )
 384                                foldl AppTy orig_ty1 orig_tys2
 385
 386 splitAppTy_maybe :: Type -> Maybe (Type, Type)
 387 splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 388 splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 389 splitAppTy_maybe (NoteTy _ ty)     = splitAppTy_maybe ty
 390 splitAppTy_maybe (TyConApp tc [])  = Nothing
 391 splitAppTy_maybe (TyConApp tc tys) = split tys []
 392                             where
 393                                split [ty2]    acc = Just (TyConApp tc (reverse acc), ty2)
 394                                split (ty:tys) acc = split tys (ty:acc)
 395
 396 splitAppTy_maybe other            = Nothing
 397
 398 splitAppTy :: Type -> (Type, Type)
 399 splitAppTy ty = case splitAppTy_maybe ty of
 400                         Just pr -> pr
 401                         Nothing -> panic "splitAppTy"
 402
 403 splitAppTys :: Type -> (Type, [Type])
 404 splitAppTys ty = split ty ty []
 405   where
 406     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
 407     split orig_ty (NoteTy _ ty)         args = split orig_ty ty args
 408     split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
 409                                                (TyConApp funTyCon [], [ty1,ty2])
 410     split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
 411     split orig_ty ty                    args = (orig_ty, args)
 412 \end{code}
 413
 414
 415 ---------------------------------------------------------------------
 416                                 FunTy
 417                                 ~~~~~
 418
 419 \begin{code}
 420 mkFunTy :: Type -> Type -> Type
 421 mkFunTy arg res = FunTy arg res
 422
 423 mkFunTys :: [Type] -> Type -> Type
 424 mkFunTys tys ty = foldr FunTy ty tys
 425
 426 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 427 splitFunTy_maybe (FunTy arg res) = Just (arg, res)
 428 splitFunTy_maybe (NoteTy _ ty)   = splitFunTy_maybe ty
 429 splitFunTy_maybe other           = Nothing
 430
 431 splitFunTys :: Type -> ([Type], Type)
 432 splitFunTys ty = split [] ty ty
 433   where
 434     split args orig_ty (FunTy arg res) = split (arg:args) res res
 435     split args orig_ty (NoteTy _ ty)   = split args orig_ty ty
 436     split args orig_ty ty              = (reverse args, orig_ty)
 437
 438 splitFunTysN :: String -> Int -> Type -> ([Type], Type)
 439 splitFunTysN msg orig_n orig_ty = split orig_n [] orig_ty orig_ty
 440   where
 441     split 0 args syn_ty ty              = (reverse args, syn_ty)
 442     split n args syn_ty (FunTy arg res) = split (n-1) (arg:args) res    res
 443     split n args syn_ty (NoteTy _ ty)   = split n     args       syn_ty ty
 444     split n args syn_ty ty              = pprPanic ("splitFunTysN: " ++ msg) (int orig_n <+> pprType orig_ty)
 445
 446 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
 447 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
 448   where
 449     split acc []     nty ty              = (reverse acc, nty)
 450     split acc (x:xs) nty (FunTy arg res) = split ((x,arg):acc) xs res res
 451     split acc xs     nty (NoteTy _ ty)   = split acc           xs nty ty
 452     split acc (x:xs) nty ty              = pprPanic "zipFunTys" (ppr orig_xs <+> pprType orig_ty)
 453
 454 funResultTy :: Type -> Type
 455 funResultTy (FunTy arg res) = res
 456 funResultTy (NoteTy _ ty)   = funResultTy ty
 457 funResultTy ty              = pprPanic "funResultTy" (pprType ty)
 458
 459 funArgTy :: Type -> Type
 460 funArgTy (FunTy arg res) = arg
 461 funArgTy (NoteTy _ ty)   = funArgTy ty
 462 funArgTy ty              = pprPanic "funArgTy" (pprType ty)
 463 \end{code}
 464
 465
 466 ---------------------------------------------------------------------
 467                                 TyConApp
 468                                 ~~~~~~~~
 469
 470 \begin{code}
 471 mkTyConApp :: TyCon -> [Type] -> Type
 472 mkTyConApp tycon tys
 473   | isFunTyCon tycon && length tys == 2
 474   = case tys of
 475         (ty1:ty2:_) -> FunTy ty1 ty2
 476
 477   | otherwise
 478   = ASSERT(not (isSynTyCon tycon))
 479     TyConApp tycon tys
 480
 481 mkTyConTy :: TyCon -> Type
 482 mkTyConTy tycon = ASSERT( not (isSynTyCon tycon) )
 483                   TyConApp tycon []
 484
 485 -- splitTyConApp "looks through" synonyms, because they don't
 486 -- mean a distinct type, but all other type-constructor applications
 487 -- including functions are returned as Just ..
 488
 489 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 490 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 491 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 492 splitTyConApp_maybe (NoteTy _ ty)     = splitTyConApp_maybe ty
 493 splitTyConApp_maybe other             = Nothing
 494
 495 -- splitAlgTyConApp_maybe looks for
 496 --      *saturated* applications of *algebraic* data types
 497 -- "Algebraic" => newtype, data type, or dictionary (not function types)
 498 -- We return the constructors too.
 499
 500 splitAlgTyConApp_maybe :: Type -> Maybe (TyCon, [Type], [DataCon])
 501 splitAlgTyConApp_maybe (TyConApp tc tys)
 502   | isAlgTyCon tc &&
 503     tyConArity tc == length tys      = Just (tc, tys, tyConDataCons tc)
 504 splitAlgTyConApp_maybe (NoteTy _ ty) = splitAlgTyConApp_maybe ty
 505 splitAlgTyConApp_maybe other         = Nothing
 506
 507 splitAlgTyConApp :: Type -> (TyCon, [Type], [DataCon])
 508         -- Here the "algebraic" property is an *assertion*
 509 splitAlgTyConApp (TyConApp tc tys) = ASSERT( isAlgTyCon tc && tyConArity tc == length tys )
 510                                      (tc, tys, tyConDataCons tc)
 511 splitAlgTyConApp (NoteTy _ ty)     = splitAlgTyConApp ty
 512 \end{code}
 513
 514 "Dictionary" types are just ordinary data types, but you can
 515 tell from the type constructor whether it's a dictionary or not.
 516
 517 \begin{code}
 518 mkDictTy :: Class -> [Type] -> Type
 519 mkDictTy clas tys = TyConApp (classTyCon clas) tys
 520
 521 splitDictTy_maybe :: Type -> Maybe (Class, [Type])
 522 splitDictTy_maybe (TyConApp tc tys)
 523   |  maybeToBool maybe_class
 524   && tyConArity tc == length tys = Just (clas, tys)
 525   where
 526      maybe_class = tyConClass_maybe tc
 527      Just clas   = maybe_class
 528
 529 splitDictTy_maybe (NoteTy _ ty) = splitDictTy_maybe ty
 530 splitDictTy_maybe other         = Nothing
 531
 532 isDictTy :: Type -> Bool
 533         -- This version is slightly more efficient than (maybeToBool . splitDictTy)
 534 isDictTy (TyConApp tc tys)
 535   |  maybeToBool (tyConClass_maybe tc)
 536   && tyConArity tc == length tys
 537   = True
 538 isDictTy (NoteTy _ ty)  = isDictTy ty
 539 isDictTy other          = False
 540 \end{code}
 541
 542 ---------------------------------------------------------------------
 543                                 SynTy
 544                                 ~~~~~
 545
 546 \begin{code}
 547 mkSynTy syn_tycon tys
 548   = ASSERT( isSynTyCon syn_tycon )
 549     ASSERT( isNotUsgTy body )
 550     ASSERT( length tyvars == length tys )
 551     NoteTy (SynNote (TyConApp syn_tycon tys))
 552            (substTy (mkTyVarSubst tyvars tys) body)
 553   where
 554     (tyvars, body) = getSynTyConDefn syn_tycon
 555
 556 isSynTy (NoteTy (SynNote _) _) = True
 557 isSynTy other                  = False
 558
 559 deNoteType :: Type -> Type
 560         -- Sorry for the cute name
 561 deNoteType ty@(TyVarTy tyvar)   = ty
 562 deNoteType (TyConApp tycon tys) = TyConApp tycon (map deNoteType tys)
 563 deNoteType (NoteTy _ ty)        = deNoteType ty
 564 deNoteType (AppTy fun arg)      = AppTy (deNoteType fun) (deNoteType arg)
 565 deNoteType (FunTy fun arg)      = FunTy (deNoteType fun) (deNoteType arg)
 566 deNoteType (ForAllTy tv ty)     = ForAllTy tv (deNoteType ty)
 567 \end{code}
 568
 569 Notes on type synonyms
 570 ~~~~~~~~~~~~~~~~~~~~~~
 571 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
 572 to return type synonyms whereever possible. Thus
 573
 574         type Foo a = a -> a
 575
 576 we want
 577         splitFunTys (a -> Foo a) = ([a], Foo a)
 578 not                                ([a], a -> a)
 579
 580 The reason is that we then get better (shorter) type signatures in
 581 interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 582
 583
 584
 585 repType looks through
 586         (a) for-alls, and
 587         (b) newtypes
 588 in addition to synonyms.  It's useful in the back end where we're not
 589 interested in newtypes anymore.
 590
 591 \begin{code}
 592 repType :: Type -> Type
 593 repType (NoteTy _ ty)                     = repType ty
 594 repType (ForAllTy _ ty)                   = repType ty
 595 repType (TyConApp tc tys) | isNewTyCon tc = repType (new_type_rep tc tys)
 596 repType other_ty                          = other_ty
 597
 598 splitNewType_maybe :: Type -> Maybe Type
 599 -- Find the representation of a newtype, if it is one
 600 splitNewType_maybe (NoteTy _ ty)                     = splitNewType_maybe ty
 601 splitNewType_maybe (TyConApp tc tys) | isNewTyCon tc = case splitNewType_maybe rep_ty of
 602                                                                 Just rep_ty' -> Just rep_ty'
 603                                                                 Nothing      -> Just rep_ty
 604                                                      where
 605                                                        rep_ty = new_type_rep tc tys
 606
 607 splitNewType_maybe other                             = Nothing
 608
 609 new_type_rep :: TyCon -> [Type] -> Type
 610 -- The representation type for (T t1 .. tn), where T is a newtype
 611 -- Looks through one layer only
 612 new_type_rep tc tys
 613   = ASSERT( isNewTyCon tc )
 614     case splitFunTy_maybe (applyTys (dataConType (head (tyConDataCons tc))) tys) of
 615         Just (rep_ty, _) -> rep_ty
 616 \end{code}
 617
 618
 619
 620 ---------------------------------------------------------------------
 621                                 UsgNote
 622                                 ~~~~~~~
 623
 624 NB: Invariant: if present, usage note is at the very top of the type.
 625 This should be carefully preserved.
 626
 627 In some parts of the compiler, comments use the _Once Upon a
 628 Polymorphic Type_ (POPL'99) usage of "sigma = usage-annotated type;
 629 tau = un-usage-annotated type"; unfortunately this conflicts with the
 630 rho/tau/theta/sigma usage in the rest of the compiler.
 631 (KSW 1999-04)
 632
 633 \begin{code}
 634 mkUsgTy :: UsageAnn -> Type -> Type
 635 #ifndef USMANY
 636 mkUsgTy UsMany ty = ASSERT2( isNotUsgTy ty, pprType ty )
 637                     ty
 638 #endif
 639 mkUsgTy usg    ty = ASSERT2( isNotUsgTy ty, pprType ty )
 640                     NoteTy (UsgNote usg) ty
 641
 642 -- The isUsgTy function is utterly useless if UsManys are omitted.
 643 -- Be warned!  KSW 1999-04.
 644 isUsgTy :: Type -> Bool
 645 #ifndef USMANY
 646 isUsgTy _ = True
 647 #else
 648 isUsgTy (NoteTy (UsgNote _) _) = True
 649 isUsgTy other                  = False
 650 #endif
 651
 652 -- The isNotUsgTy function may return a false True if UsManys are omitted;
 653 -- in other words, A SSERT( isNotUsgTy ty ) may be useful but
 654 -- A SSERT( not (isNotUsg ty) ) is asking for trouble.  KSW 1999-04.
 655 isNotUsgTy :: Type -> Bool
 656 isNotUsgTy (NoteTy (UsgNote _) _) = False
 657 isNotUsgTy other                  = True
 658
 659 -- splitUsgTy_maybe is not exported, since it is meaningless if
 660 -- UsManys are omitted.  It is used in several places in this module,
 661 -- however.  KSW 1999-04.
 662 splitUsgTy_maybe :: Type -> Maybe (UsageAnn,Type)
 663 splitUsgTy_maybe (NoteTy (UsgNote usg) ty2) = ASSERT( isNotUsgTy ty2 )
 664                                               Just (usg,ty2)
 665 splitUsgTy_maybe ty                         = Nothing
 666
 667 splitUsgTy :: Type -> (UsageAnn,Type)
 668 splitUsgTy ty = case splitUsgTy_maybe ty of
 669                   Just ans -> ans
 670                   Nothing  ->
 671 #ifndef USMANY
 672                               (UsMany,ty)
 673 #else
 674                               pprPanic "splitUsgTy: no usage annot:" $ pprType ty
 675 #endif
 676
 677 tyUsg :: Type -> UsageAnn
 678 tyUsg = fst . splitUsgTy
 679
 680 unUsgTy :: Type -> Type
 681 -- strip outer usage annotation if present
 682 unUsgTy ty = case splitUsgTy_maybe ty of
 683                Just (_,ty1) -> ASSERT2( isNotUsgTy ty1, pprType ty )
 684                                ty1
 685                Nothing      -> ty
 686 \end{code}
 687
 688
 689
 690 ---------------------------------------------------------------------
 691                                 ForAllTy
 692                                 ~~~~~~~~
 693
 694 We need to be clever here with usage annotations; they need to be
 695 lifted or lowered through the forall as appropriate.
 696
 697 \begin{code}
 698 mkForAllTy :: TyVar -> Type -> Type
 699 mkForAllTy tyvar ty = case splitUsgTy_maybe ty of
 700                         Just (usg,ty') -> NoteTy (UsgNote usg)
 701                                                  (ForAllTy tyvar ty')
 702                         Nothing        -> ForAllTy tyvar ty
 703
 704 mkForAllTys :: [TyVar] -> Type -> Type
 705 mkForAllTys tyvars ty = case splitUsgTy_maybe ty of
 706                           Just (usg,ty') -> NoteTy (UsgNote usg)
 707                                                    (foldr ForAllTy ty' tyvars)
 708                           Nothing        -> foldr ForAllTy ty tyvars
 709
 710 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 711 splitForAllTy_maybe ty = case splitUsgTy_maybe ty of
 712                            Just (usg,ty') -> do (tyvar,ty'') <- splitFAT_m ty'
 713                                                 return (tyvar, NoteTy (UsgNote usg) ty'')
 714                            Nothing        -> splitFAT_m ty
 715   where
 716     splitFAT_m (NoteTy _ ty)       = splitFAT_m ty
 717     splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
 718     splitFAT_m _                   = Nothing
 719
 720 isForAllTy :: Type -> Bool
 721 isForAllTy (NoteTy _ ty)       = isForAllTy ty
 722 isForAllTy (ForAllTy tyvar ty) = True
 723 isForAllTy _                 = False
 724
 725 splitForAllTys :: Type -> ([TyVar], Type)
 726 splitForAllTys ty = case splitUsgTy_maybe ty of
 727                       Just (usg,ty') -> let (tvs,ty'') = split ty' ty' []
 728                                         in  (tvs, NoteTy (UsgNote usg) ty'')
 729                       Nothing        -> split ty ty []
 730    where
 731      split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
 732      split orig_ty (NoteTy _ ty)    tvs = split orig_ty ty tvs
 733      split orig_ty t                tvs = (reverse tvs, orig_ty)
 734 \end{code}
 735
 736 @mkPiType@ makes a (->) type or a forall type, depending on whether
 737 it is given a type variable or a term variable.
 738
 739 \begin{code}
 740 mkPiType :: IdOrTyVar -> Type -> Type   -- The more polymorphic version doesn't work...
 741 mkPiType v ty | isId v    = mkFunTy (idType v) ty
 742               | otherwise = mkForAllTy v ty
 743 \end{code}
 744
 745 Applying a for-all to its arguments
 746
 747 \begin{code}
 748 applyTy :: Type -> Type -> Type
 749 applyTy (NoteTy note@(UsgNote _) fun) arg = NoteTy note (applyTy fun arg)
 750 applyTy (NoteTy _ fun)                arg = applyTy fun arg
 751 applyTy (ForAllTy tv ty)              arg = ASSERT( isNotUsgTy arg )
 752                                             substTy (mkTyVarSubst [tv] [arg]) ty
 753 applyTy other                         arg = panic "applyTy"
 754
 755 applyTys :: Type -> [Type] -> Type
 756 applyTys fun_ty arg_tys
 757  = substTy (mkTyVarSubst tvs arg_tys) ty
 758  where
 759    (tvs, ty) = split fun_ty arg_tys
 760
 761    split fun_ty               []         = ([], fun_ty)
 762    split (NoteTy _ fun_ty)    args       = split fun_ty args
 763    split (ForAllTy tv fun_ty) (arg:args) = ASSERT2( isNotUsgTy arg, vcat (map pprType arg_tys) $$
 764                                                                     text "in application of" <+> pprType fun_ty)
 765                                            case split fun_ty args of
 766                                                   (tvs, ty) -> (tv:tvs, ty)
 767    split other_ty             args       = panic "applyTys"
 768
 769 {-              OLD version with bogus usage stuff
 770
 771         ************* CHECK WITH KEITH **************
 772
 773    go env ty               []         = substTy (mkVarEnv env) ty
 774    go env (NoteTy note@(UsgNote _) fun)
 775                            args       = NoteTy note (go env fun args)
 776    go env (NoteTy _ fun)   args       = go env fun args
 777    go env (ForAllTy tv ty) (arg:args) = go ((tv,arg):env) ty args
 778    go env other            args       = panic "applyTys"
 779 -}
 780 \end{code}
 781
 782 Note that we allow applications to be of usage-annotated- types, as an
 783 extension: we handle them by lifting the annotation outside.  The
 784 argument, however, must still be unannotated.
 785
 786 %************************************************************************
 787 %*                                                                      *
 788 \subsection{Stuff to do with the source-language types}
 789 %*                                                                      *
 790 %************************************************************************
 791
 792 \begin{code}
 793 type RhoType   = Type
 794 type TauType   = Type
 795 type ThetaType = [(Class, [Type])]
 796 type SigmaType = Type
 797 \end{code}
 798
 799 @isTauTy@ tests for nested for-alls.
 800
 801 \begin{code}
 802 isTauTy :: Type -> Bool
 803 isTauTy (TyVarTy v)      = True
 804 isTauTy (TyConApp _ tys) = all isTauTy tys
 805 isTauTy (AppTy a b)      = isTauTy a && isTauTy b
 806 isTauTy (FunTy a b)      = isTauTy a && isTauTy b
 807 isTauTy (NoteTy _ ty)    = isTauTy ty
 808 isTauTy other            = False
 809 \end{code}
 810
 811 \begin{code}
 812 mkRhoTy :: [(Class, [Type])] -> Type -> Type
 813 mkRhoTy theta ty = foldr (\(c,t) r -> FunTy (mkDictTy c t) r) ty theta
 814
 815 splitRhoTy :: Type -> ([(Class, [Type])], Type)
 816 splitRhoTy ty = split ty ty []
 817  where
 818   split orig_ty (FunTy arg res) ts = case splitDictTy_maybe arg of
 819                                         Just pair -> split res res (pair:ts)
 820                                         Nothing   -> (reverse ts, orig_ty)
 821   split orig_ty (NoteTy _ ty) ts   = split orig_ty ty ts
 822   split orig_ty ty ts              = (reverse ts, orig_ty)
 823 \end{code}
 824
 825
 826
 827 \begin{code}
 828 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
 829
 830 splitSigmaTy :: Type -> ([TyVar], [(Class, [Type])], Type)
 831 splitSigmaTy ty =
 832   (tyvars, theta, tau)
 833  where
 834   (tyvars,rho) = splitForAllTys ty
 835   (theta,tau)  = splitRhoTy rho
 836 \end{code}
 837
 838
 839 %************************************************************************
 840 %*                                                                      *
 841 \subsection{Kinds and free variables}
 842 %*                                                                      *
 843 %************************************************************************
 844
 845 ---------------------------------------------------------------------
 846                 Finding the kind of a type
 847                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 848 \begin{code}
 849 typeKind :: Type -> Kind
 850
 851 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 852 typeKind (TyConApp tycon tys)   = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
 853 typeKind (NoteTy _ ty)          = typeKind ty
 854 typeKind (AppTy fun arg)        = funResultTy (typeKind fun)
 855
 856 typeKind (FunTy arg res)        = boxedTypeKind -- A function is boxed regardless of its result type
 857                                                 -- No functions at the type level, hence we don't need
 858                                                 -- to say (typeKind res).
 859
 860 typeKind (ForAllTy tv ty)       = typeKind ty
 861 \end{code}
 862
 863
 864 ---------------------------------------------------------------------
 865                 Free variables of a type
 866                 ~~~~~~~~~~~~~~~~~~~~~~~~
 867 \begin{code}
 868 tyVarsOfType :: Type -> TyVarSet
 869
 870 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 871 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 872 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 873 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty1
 874 tyVarsOfType (NoteTy (UsgNote _) ty)    = tyVarsOfType ty
 875 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 876 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 877 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 878
 879 tyVarsOfTypes :: [Type] -> TyVarSet
 880 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 881
 882 -- Add a Note with the free tyvars to the top of the type
 883 -- (but under a usage if there is one)
 884 addFreeTyVars :: Type -> Type
 885 addFreeTyVars (NoteTy note@(UsgNote _) ty) = NoteTy note (addFreeTyVars ty)
 886 addFreeTyVars ty@(NoteTy (FTVNote _) _)    = ty
 887 addFreeTyVars ty                           = NoteTy (FTVNote (tyVarsOfType ty)) ty
 888
 889 -- Find the free names of a type, including the type constructors and classes it mentions
 890 namesOfType :: Type -> NameSet
 891 namesOfType (TyVarTy tv)                = unitNameSet (getName tv)
 892 namesOfType (TyConApp tycon tys)        = unitNameSet (getName tycon) `unionNameSets`
 893                                           namesOfTypes tys
 894 namesOfType (NoteTy (SynNote ty1) ty2)  = namesOfType ty1
 895 namesOfType (NoteTy other_note    ty2)  = namesOfType ty2
 896 namesOfType (FunTy arg res)             = namesOfType arg `unionNameSets` namesOfType res
 897 namesOfType (AppTy fun arg)             = namesOfType fun `unionNameSets` namesOfType arg
 898 namesOfType (ForAllTy tyvar ty)         = namesOfType ty `minusNameSet` unitNameSet (getName tyvar)
 899
 900 namesOfTypes tys = foldr (unionNameSets . namesOfType) emptyNameSet tys
 901 \end{code}
 902
 903
 904 %************************************************************************
 905 %*                                                                      *
 906 \subsection{TidyType}
 907 %*                                                                      *
 908 %************************************************************************
 909
 910 tidyTy tidies up a type for printing in an error message, or in
 911 an interface file.
 912
 913 It doesn't change the uniques at all, just the print names.
 914
 915 \begin{code}
 916 tidyTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 917 tidyTyVar env@(tidy_env, subst) tyvar
 918   = case lookupVarEnv subst tyvar of
 919
 920         Just tyvar' ->  -- Already substituted
 921                 (env, tyvar')
 922
 923         Nothing ->      -- Make a new nice name for it
 924
 925                 case tidyOccName tidy_env (getOccName name) of
 926                     (tidy', occ') ->    -- New occname reqd
 927                                 ((tidy', subst'), tyvar')
 928                               where
 929                                 subst' = extendVarEnv subst tyvar tyvar'
 930                                 tyvar' = setTyVarName tyvar name'
 931                                 name'  = mkLocalName (getUnique name) occ' noSrcLoc
 932                                         -- Note: make a *user* tyvar, so it printes nicely
 933                                         -- Could extract src loc, but no need.
 934   where
 935     name = tyVarName tyvar
 936
 937 tidyTyVars env tyvars = mapAccumL tidyTyVar env tyvars
 938
 939 tidyType :: TidyEnv -> Type -> Type
 940 tidyType env@(tidy_env, subst) ty
 941   = go ty
 942   where
 943     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 944                                 Nothing  -> TyVarTy tv
 945                                 Just tv' -> TyVarTy tv'
 946     go (TyConApp tycon tys) = let args = map go tys
 947                               in args `seqList` TyConApp tycon args
 948     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 949     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 950     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 951     go (ForAllTy tv ty)     = ForAllTy tv' $! (tidyType env' ty)
 952                             where
 953                               (env', tv') = tidyTyVar env tv
 954
 955     go_note (SynNote ty)        = SynNote $! (go ty)
 956     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 957     go_note note@(UsgNote _)    = note  -- Usage annotation is already tidy
 958
 959 tidyTypes  env tys    = map (tidyType env) tys
 960 \end{code}
 961
 962
 963 @tidyOpenType@ grabs the free type varibles, tidies them
 964 and then uses @tidyType@ to work over the type itself
 965
 966 \begin{code}
 967 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 968 tidyOpenType env ty
 969   = (env', tidyType env' ty)
 970   where
 971     env'         = foldl go env (varSetElems (tyVarsOfType ty))
 972     go env tyvar = fst (tidyTyVar env tyvar)
 973
 974 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 975 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 976
 977 tidyTopType :: Type -> Type
 978 tidyTopType ty = tidyType emptyTidyEnv ty
 979 \end{code}
 980
 981
 982 %************************************************************************
 983 %*                                                                      *
 984 \subsection{Boxedness and liftedness}
 985 %*                                                                      *
 986 %************************************************************************
 987
 988 \begin{code}
 989 isUnboxedType :: Type -> Bool
 990 isUnboxedType ty = not (isFollowableRep (typePrimRep ty))
 991
 992 isUnLiftedType :: Type -> Bool
 993 isUnLiftedType ty = case splitTyConApp_maybe ty of
 994                            Just (tc, ty_args) -> isUnLiftedTyCon tc
 995                            other              -> False
 996
 997 isUnboxedTupleType :: Type -> Bool
 998 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 999                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
1000                            other              -> False
1001
1002 -- Should only be applied to *types*; hence the assert
1003 isAlgType :: Type -> Bool
1004 isAlgType ty = case splitTyConApp_maybe ty of
1005                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1006                                               isAlgTyCon tc
1007                         other              -> False
1008
1009 -- Should only be applied to *types*; hence the assert
1010 isDataType :: Type -> Bool
1011 isDataType ty = case splitTyConApp_maybe ty of
1012                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1013                                               isDataTyCon tc
1014                         other              -> False
1015
1016 isNewType :: Type -> Bool
1017 isNewType ty = case splitTyConApp_maybe ty of
1018                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1019                                               isNewTyCon tc
1020                         other              -> False
1021
1022 typePrimRep :: Type -> PrimRep
1023 typePrimRep ty = case splitTyConApp_maybe ty of
1024                    Just (tc, ty_args) -> tyConPrimRep tc
1025                    other              -> PtrRep
1026 \end{code}
1027
1028 %************************************************************************
1029 %*                                                                      *
1030 \subsection{Equality on types}
1031 %*                                                                      *
1032 %************************************************************************
1033
1034 For the moment at least, type comparisons don't work if
1035 there are embedded for-alls.
1036
1037 \begin{code}
1038 instance Eq Type where
1039   ty1 == ty2 = case ty1 `cmpTy` ty2 of { EQ -> True; other -> False }
1040
1041 instance Ord Type where
1042   compare ty1 ty2 = cmpTy ty1 ty2
1043
1044 cmpTy :: Type -> Type -> Ordering
1045 cmpTy ty1 ty2
1046   = cmp emptyVarEnv ty1 ty2
1047   where
1048   -- The "env" maps type variables in ty1 to type variables in ty2
1049   -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
1050   -- we in effect substitute tv2 for tv1 in t1 before continuing
1051     lookup env tv1 = case lookupVarEnv env tv1 of
1052                           Just tv2 -> tv2
1053                           Nothing  -> tv1
1054
1055     -- Get rid of NoteTy
1056     cmp env (NoteTy _ ty1) ty2 = cmp env ty1 ty2
1057     cmp env ty1 (NoteTy _ ty2) = cmp env ty1 ty2
1058
1059     -- Deal with equal constructors
1060     cmp env (TyVarTy tv1) (TyVarTy tv2) = lookup env tv1 `compare` tv2
1061     cmp env (AppTy f1 a1) (AppTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
1062     cmp env (FunTy f1 a1) (FunTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
1063     cmp env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmps env tys1 tys2)
1064     cmp env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmp (extendVarEnv env tv1 tv2) t1 t2
1065
1066     -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy
1067     cmp env (AppTy _ _) (TyVarTy _) = GT
1068
1069     cmp env (FunTy _ _) (TyVarTy _) = GT
1070     cmp env (FunTy _ _) (AppTy _ _) = GT
1071
1072     cmp env (TyConApp _ _) (TyVarTy _) = GT
1073     cmp env (TyConApp _ _) (AppTy _ _) = GT
1074     cmp env (TyConApp _ _) (FunTy _ _) = GT
1075
1076     cmp env (ForAllTy _ _) other       = GT
1077
1078     cmp env _ _                        = LT
1079
1080     cmps env []     [] = EQ
1081     cmps env (t:ts) [] = GT
1082     cmps env [] (t:ts) = LT
1083     cmps env (t1:t1s) (t2:t2s) = cmp env t1 t2 `thenCmp` cmps env t1s t2s
1084 \end{code}
1085
1086
1087 %************************************************************************
1088 %*                                                                      *
1089 \subsection{Sequencing on types
1090 %*                                                                      *
1091 %************************************************************************
1092
1093 \begin{code}
1094 seqType :: Type -> ()
1095 seqType (TyVarTy tv)      = tv `seq` ()
1096 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
1097 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
1098 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
1099 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
1100 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
1101
1102 seqTypes :: [Type] -> ()
1103 seqTypes []       = ()
1104 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
1105
1106 seqNote :: TyNote -> ()
1107 seqNote (SynNote ty)  = seqType ty
1108 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
1109 seqNote (UsgNote usg) = usg `seq` ()
1110 \end{code}
1111