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 -- Looks through multiple levels of newtype
 601 splitNewType_maybe (NoteTy _ ty)                     = splitNewType_maybe ty
 602 splitNewType_maybe (TyConApp tc tys) | isNewTyCon tc = case splitNewType_maybe rep_ty of
 603                                                                 Just rep_ty' -> Just rep_ty'
 604                                                                 Nothing      -> Just rep_ty
 605                                                      where
 606                                                        rep_ty = new_type_rep tc tys
 607
 608 splitNewType_maybe other                             = Nothing
 609
 610 new_type_rep :: TyCon -> [Type] -> Type
 611 -- The representation type for (T t1 .. tn), where T is a newtype
 612 -- Looks through one layer only
 613 new_type_rep tc tys
 614   = ASSERT( isNewTyCon tc )
 615     case splitFunTy_maybe (applyTys (dataConType (head (tyConDataCons tc))) tys) of
 616         Just (rep_ty, _) -> rep_ty
 617 \end{code}
 618
 619
 620
 621 ---------------------------------------------------------------------
 622                                 UsgNote
 623                                 ~~~~~~~
 624
 625 NB: Invariant: if present, usage note is at the very top of the type.
 626 This should be carefully preserved.
 627
 628 In some parts of the compiler, comments use the _Once Upon a
 629 Polymorphic Type_ (POPL'99) usage of "sigma = usage-annotated type;
 630 tau = un-usage-annotated type"; unfortunately this conflicts with the
 631 rho/tau/theta/sigma usage in the rest of the compiler.
 632 (KSW 1999-04)
 633
 634 \begin{code}
 635 mkUsgTy :: UsageAnn -> Type -> Type
 636 #ifndef USMANY
 637 mkUsgTy UsMany ty = ASSERT2( isNotUsgTy ty, pprType ty )
 638                     ty
 639 #endif
 640 mkUsgTy usg    ty = ASSERT2( isNotUsgTy ty, pprType ty )
 641                     NoteTy (UsgNote usg) ty
 642
 643 -- The isUsgTy function is utterly useless if UsManys are omitted.
 644 -- Be warned!  KSW 1999-04.
 645 isUsgTy :: Type -> Bool
 646 #ifndef USMANY
 647 isUsgTy _ = True
 648 #else
 649 isUsgTy (NoteTy (UsgNote _) _) = True
 650 isUsgTy other                  = False
 651 #endif
 652
 653 -- The isNotUsgTy function may return a false True if UsManys are omitted;
 654 -- in other words, A SSERT( isNotUsgTy ty ) may be useful but
 655 -- A SSERT( not (isNotUsg ty) ) is asking for trouble.  KSW 1999-04.
 656 isNotUsgTy :: Type -> Bool
 657 isNotUsgTy (NoteTy (UsgNote _) _) = False
 658 isNotUsgTy other                  = True
 659
 660 -- splitUsgTy_maybe is not exported, since it is meaningless if
 661 -- UsManys are omitted.  It is used in several places in this module,
 662 -- however.  KSW 1999-04.
 663 splitUsgTy_maybe :: Type -> Maybe (UsageAnn,Type)
 664 splitUsgTy_maybe (NoteTy (UsgNote usg) ty2) = ASSERT( isNotUsgTy ty2 )
 665                                               Just (usg,ty2)
 666 splitUsgTy_maybe ty                         = Nothing
 667
 668 splitUsgTy :: Type -> (UsageAnn,Type)
 669 splitUsgTy ty = case splitUsgTy_maybe ty of
 670                   Just ans -> ans
 671                   Nothing  ->
 672 #ifndef USMANY
 673                               (UsMany,ty)
 674 #else
 675                               pprPanic "splitUsgTy: no usage annot:" $ pprType ty
 676 #endif
 677
 678 tyUsg :: Type -> UsageAnn
 679 tyUsg = fst . splitUsgTy
 680
 681 unUsgTy :: Type -> Type
 682 -- strip outer usage annotation if present
 683 unUsgTy ty = case splitUsgTy_maybe ty of
 684                Just (_,ty1) -> ASSERT2( isNotUsgTy ty1, pprType ty )
 685                                ty1
 686                Nothing      -> ty
 687 \end{code}
 688
 689
 690
 691 ---------------------------------------------------------------------
 692                                 ForAllTy
 693                                 ~~~~~~~~
 694
 695 We need to be clever here with usage annotations; they need to be
 696 lifted or lowered through the forall as appropriate.
 697
 698 \begin{code}
 699 mkForAllTy :: TyVar -> Type -> Type
 700 mkForAllTy tyvar ty = case splitUsgTy_maybe ty of
 701                         Just (usg,ty') -> NoteTy (UsgNote usg)
 702                                                  (ForAllTy tyvar ty')
 703                         Nothing        -> ForAllTy tyvar ty
 704
 705 mkForAllTys :: [TyVar] -> Type -> Type
 706 mkForAllTys tyvars ty = case splitUsgTy_maybe ty of
 707                           Just (usg,ty') -> NoteTy (UsgNote usg)
 708                                                    (foldr ForAllTy ty' tyvars)
 709                           Nothing        -> foldr ForAllTy ty tyvars
 710
 711 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 712 splitForAllTy_maybe ty = case splitUsgTy_maybe ty of
 713                            Just (usg,ty') -> do (tyvar,ty'') <- splitFAT_m ty'
 714                                                 return (tyvar, NoteTy (UsgNote usg) ty'')
 715                            Nothing        -> splitFAT_m ty
 716   where
 717     splitFAT_m (NoteTy _ ty)       = splitFAT_m ty
 718     splitFAT_m (ForAllTy tyvar ty) = Just(tyvar, ty)
 719     splitFAT_m _                   = Nothing
 720
 721 isForAllTy :: Type -> Bool
 722 isForAllTy (NoteTy _ ty)       = isForAllTy ty
 723 isForAllTy (ForAllTy tyvar ty) = True
 724 isForAllTy _                 = False
 725
 726 splitForAllTys :: Type -> ([TyVar], Type)
 727 splitForAllTys ty = case splitUsgTy_maybe ty of
 728                       Just (usg,ty') -> let (tvs,ty'') = split ty' ty' []
 729                                         in  (tvs, NoteTy (UsgNote usg) ty'')
 730                       Nothing        -> split ty ty []
 731    where
 732      split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
 733      split orig_ty (NoteTy _ ty)    tvs = split orig_ty ty tvs
 734      split orig_ty t                tvs = (reverse tvs, orig_ty)
 735 \end{code}
 736
 737 @mkPiType@ makes a (->) type or a forall type, depending on whether
 738 it is given a type variable or a term variable.
 739
 740 \begin{code}
 741 mkPiType :: IdOrTyVar -> Type -> Type   -- The more polymorphic version doesn't work...
 742 mkPiType v ty | isId v    = mkFunTy (idType v) ty
 743               | otherwise = mkForAllTy v ty
 744 \end{code}
 745
 746 Applying a for-all to its arguments
 747
 748 \begin{code}
 749 applyTy :: Type -> Type -> Type
 750 applyTy (NoteTy note@(UsgNote _) fun) arg = NoteTy note (applyTy fun arg)
 751 applyTy (NoteTy _ fun)                arg = applyTy fun arg
 752 applyTy (ForAllTy tv ty)              arg = ASSERT( isNotUsgTy arg )
 753                                             substTy (mkTyVarSubst [tv] [arg]) ty
 754 applyTy other                         arg = panic "applyTy"
 755
 756 applyTys :: Type -> [Type] -> Type
 757 applyTys fun_ty arg_tys
 758  = substTy (mkTyVarSubst tvs arg_tys) ty
 759  where
 760    (tvs, ty) = split fun_ty arg_tys
 761
 762    split fun_ty               []         = ([], fun_ty)
 763    split (NoteTy _ fun_ty)    args       = split fun_ty args
 764    split (ForAllTy tv fun_ty) (arg:args) = ASSERT2( isNotUsgTy arg, vcat (map pprType arg_tys) $$
 765                                                                     text "in application of" <+> pprType fun_ty)
 766                                            case split fun_ty args of
 767                                                   (tvs, ty) -> (tv:tvs, ty)
 768    split other_ty             args       = panic "applyTys"
 769
 770 {-              OLD version with bogus usage stuff
 771
 772         ************* CHECK WITH KEITH **************
 773
 774    go env ty               []         = substTy (mkVarEnv env) ty
 775    go env (NoteTy note@(UsgNote _) fun)
 776                            args       = NoteTy note (go env fun args)
 777    go env (NoteTy _ fun)   args       = go env fun args
 778    go env (ForAllTy tv ty) (arg:args) = go ((tv,arg):env) ty args
 779    go env other            args       = panic "applyTys"
 780 -}
 781 \end{code}
 782
 783 Note that we allow applications to be of usage-annotated- types, as an
 784 extension: we handle them by lifting the annotation outside.  The
 785 argument, however, must still be unannotated.
 786
 787 %************************************************************************
 788 %*                                                                      *
 789 \subsection{Stuff to do with the source-language types}
 790 %*                                                                      *
 791 %************************************************************************
 792
 793 \begin{code}
 794 type RhoType   = Type
 795 type TauType   = Type
 796 type ThetaType = [(Class, [Type])]
 797 type SigmaType = Type
 798 \end{code}
 799
 800 @isTauTy@ tests for nested for-alls.
 801
 802 \begin{code}
 803 isTauTy :: Type -> Bool
 804 isTauTy (TyVarTy v)      = True
 805 isTauTy (TyConApp _ tys) = all isTauTy tys
 806 isTauTy (AppTy a b)      = isTauTy a && isTauTy b
 807 isTauTy (FunTy a b)      = isTauTy a && isTauTy b
 808 isTauTy (NoteTy _ ty)    = isTauTy ty
 809 isTauTy other            = False
 810 \end{code}
 811
 812 \begin{code}
 813 mkRhoTy :: [(Class, [Type])] -> Type -> Type
 814 mkRhoTy theta ty = foldr (\(c,t) r -> FunTy (mkDictTy c t) r) ty theta
 815
 816 splitRhoTy :: Type -> ([(Class, [Type])], Type)
 817 splitRhoTy ty = split ty ty []
 818  where
 819   split orig_ty (FunTy arg res) ts = case splitDictTy_maybe arg of
 820                                         Just pair -> split res res (pair:ts)
 821                                         Nothing   -> (reverse ts, orig_ty)
 822   split orig_ty (NoteTy _ ty) ts   = split orig_ty ty ts
 823   split orig_ty ty ts              = (reverse ts, orig_ty)
 824 \end{code}
 825
 826
 827
 828 \begin{code}
 829 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
 830
 831 splitSigmaTy :: Type -> ([TyVar], [(Class, [Type])], Type)
 832 splitSigmaTy ty =
 833   (tyvars, theta, tau)
 834  where
 835   (tyvars,rho) = splitForAllTys ty
 836   (theta,tau)  = splitRhoTy rho
 837 \end{code}
 838
 839
 840 %************************************************************************
 841 %*                                                                      *
 842 \subsection{Kinds and free variables}
 843 %*                                                                      *
 844 %************************************************************************
 845
 846 ---------------------------------------------------------------------
 847                 Finding the kind of a type
 848                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 849 \begin{code}
 850 typeKind :: Type -> Kind
 851
 852 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 853 typeKind (TyConApp tycon tys)   = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
 854 typeKind (NoteTy _ ty)          = typeKind ty
 855 typeKind (AppTy fun arg)        = funResultTy (typeKind fun)
 856
 857 typeKind (FunTy arg res)        = boxedTypeKind -- A function is boxed regardless of its result type
 858                                                 -- No functions at the type level, hence we don't need
 859                                                 -- to say (typeKind res).
 860
 861 typeKind (ForAllTy tv ty)       = typeKind ty
 862 \end{code}
 863
 864
 865 ---------------------------------------------------------------------
 866                 Free variables of a type
 867                 ~~~~~~~~~~~~~~~~~~~~~~~~
 868 \begin{code}
 869 tyVarsOfType :: Type -> TyVarSet
 870
 871 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 872 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 873 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 874 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty1
 875 tyVarsOfType (NoteTy (UsgNote _) ty)    = tyVarsOfType ty
 876 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 877 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 878 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 879
 880 tyVarsOfTypes :: [Type] -> TyVarSet
 881 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 882
 883 -- Add a Note with the free tyvars to the top of the type
 884 -- (but under a usage if there is one)
 885 addFreeTyVars :: Type -> Type
 886 addFreeTyVars (NoteTy note@(UsgNote _) ty) = NoteTy note (addFreeTyVars ty)
 887 addFreeTyVars ty@(NoteTy (FTVNote _) _)    = ty
 888 addFreeTyVars ty                           = NoteTy (FTVNote (tyVarsOfType ty)) ty
 889
 890 -- Find the free names of a type, including the type constructors and classes it mentions
 891 namesOfType :: Type -> NameSet
 892 namesOfType (TyVarTy tv)                = unitNameSet (getName tv)
 893 namesOfType (TyConApp tycon tys)        = unitNameSet (getName tycon) `unionNameSets`
 894                                           namesOfTypes tys
 895 namesOfType (NoteTy (SynNote ty1) ty2)  = namesOfType ty1
 896 namesOfType (NoteTy other_note    ty2)  = namesOfType ty2
 897 namesOfType (FunTy arg res)             = namesOfType arg `unionNameSets` namesOfType res
 898 namesOfType (AppTy fun arg)             = namesOfType fun `unionNameSets` namesOfType arg
 899 namesOfType (ForAllTy tyvar ty)         = namesOfType ty `minusNameSet` unitNameSet (getName tyvar)
 900
 901 namesOfTypes tys = foldr (unionNameSets . namesOfType) emptyNameSet tys
 902 \end{code}
 903
 904
 905 %************************************************************************
 906 %*                                                                      *
 907 \subsection{TidyType}
 908 %*                                                                      *
 909 %************************************************************************
 910
 911 tidyTy tidies up a type for printing in an error message, or in
 912 an interface file.
 913
 914 It doesn't change the uniques at all, just the print names.
 915
 916 \begin{code}
 917 tidyTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 918 tidyTyVar env@(tidy_env, subst) tyvar
 919   = case lookupVarEnv subst tyvar of
 920
 921         Just tyvar' ->  -- Already substituted
 922                 (env, tyvar')
 923
 924         Nothing ->      -- Make a new nice name for it
 925
 926                 case tidyOccName tidy_env (getOccName name) of
 927                     (tidy', occ') ->    -- New occname reqd
 928                                 ((tidy', subst'), tyvar')
 929                               where
 930                                 subst' = extendVarEnv subst tyvar tyvar'
 931                                 tyvar' = setTyVarName tyvar name'
 932                                 name'  = mkLocalName (getUnique name) occ' noSrcLoc
 933                                         -- Note: make a *user* tyvar, so it printes nicely
 934                                         -- Could extract src loc, but no need.
 935   where
 936     name = tyVarName tyvar
 937
 938 tidyTyVars env tyvars = mapAccumL tidyTyVar env tyvars
 939
 940 tidyType :: TidyEnv -> Type -> Type
 941 tidyType env@(tidy_env, subst) ty
 942   = go ty
 943   where
 944     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 945                                 Nothing  -> TyVarTy tv
 946                                 Just tv' -> TyVarTy tv'
 947     go (TyConApp tycon tys) = let args = map go tys
 948                               in args `seqList` TyConApp tycon args
 949     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 950     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 951     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 952     go (ForAllTy tv ty)     = ForAllTy tv' $! (tidyType env' ty)
 953                             where
 954                               (env', tv') = tidyTyVar env tv
 955
 956     go_note (SynNote ty)        = SynNote $! (go ty)
 957     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 958     go_note note@(UsgNote _)    = note  -- Usage annotation is already tidy
 959
 960 tidyTypes  env tys    = map (tidyType env) tys
 961 \end{code}
 962
 963
 964 @tidyOpenType@ grabs the free type varibles, tidies them
 965 and then uses @tidyType@ to work over the type itself
 966
 967 \begin{code}
 968 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 969 tidyOpenType env ty
 970   = (env', tidyType env' ty)
 971   where
 972     env'         = foldl go env (varSetElems (tyVarsOfType ty))
 973     go env tyvar = fst (tidyTyVar env tyvar)
 974
 975 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 976 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 977
 978 tidyTopType :: Type -> Type
 979 tidyTopType ty = tidyType emptyTidyEnv ty
 980 \end{code}
 981
 982
 983 %************************************************************************
 984 %*                                                                      *
 985 \subsection{Boxedness and liftedness}
 986 %*                                                                      *
 987 %************************************************************************
 988
 989 \begin{code}
 990 isUnboxedType :: Type -> Bool
 991 isUnboxedType ty = not (isFollowableRep (typePrimRep ty))
 992
 993 isUnLiftedType :: Type -> Bool
 994 isUnLiftedType ty = case splitTyConApp_maybe ty of
 995                            Just (tc, ty_args) -> isUnLiftedTyCon tc
 996                            other              -> False
 997
 998 isUnboxedTupleType :: Type -> Bool
 999 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
1000                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
1001                            other              -> False
1002
1003 -- Should only be applied to *types*; hence the assert
1004 isAlgType :: Type -> Bool
1005 isAlgType ty = case splitTyConApp_maybe ty of
1006                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1007                                               isAlgTyCon tc
1008                         other              -> False
1009
1010 -- Should only be applied to *types*; hence the assert
1011 isDataType :: Type -> Bool
1012 isDataType ty = case splitTyConApp_maybe ty of
1013                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1014                                               isDataTyCon tc
1015                         other              -> False
1016
1017 isNewType :: Type -> Bool
1018 isNewType ty = case splitTyConApp_maybe ty of
1019                         Just (tc, ty_args) -> ASSERT( length ty_args == tyConArity tc )
1020                                               isNewTyCon tc
1021                         other              -> False
1022
1023 typePrimRep :: Type -> PrimRep
1024 typePrimRep ty = case splitTyConApp_maybe ty of
1025                    Just (tc, ty_args) -> tyConPrimRep tc
1026                    other              -> PtrRep
1027 \end{code}
1028
1029 %************************************************************************
1030 %*                                                                      *
1031 \subsection{Equality on types}
1032 %*                                                                      *
1033 %************************************************************************
1034
1035 For the moment at least, type comparisons don't work if
1036 there are embedded for-alls.
1037
1038 \begin{code}
1039 instance Eq Type where
1040   ty1 == ty2 = case ty1 `cmpTy` ty2 of { EQ -> True; other -> False }
1041
1042 instance Ord Type where
1043   compare ty1 ty2 = cmpTy ty1 ty2
1044
1045 cmpTy :: Type -> Type -> Ordering
1046 cmpTy ty1 ty2
1047   = cmp emptyVarEnv ty1 ty2
1048   where
1049   -- The "env" maps type variables in ty1 to type variables in ty2
1050   -- So when comparing for-alls.. (forall tv1 . t1) (forall tv2 . t2)
1051   -- we in effect substitute tv2 for tv1 in t1 before continuing
1052     lookup env tv1 = case lookupVarEnv env tv1 of
1053                           Just tv2 -> tv2
1054                           Nothing  -> tv1
1055
1056     -- Get rid of NoteTy
1057     cmp env (NoteTy _ ty1) ty2 = cmp env ty1 ty2
1058     cmp env ty1 (NoteTy _ ty2) = cmp env ty1 ty2
1059
1060     -- Deal with equal constructors
1061     cmp env (TyVarTy tv1) (TyVarTy tv2) = lookup env tv1 `compare` tv2
1062     cmp env (AppTy f1 a1) (AppTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
1063     cmp env (FunTy f1 a1) (FunTy f2 a2) = cmp env f1 f2 `thenCmp` cmp env a1 a2
1064     cmp env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` (cmps env tys1 tys2)
1065     cmp env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmp (extendVarEnv env tv1 tv2) t1 t2
1066
1067     -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy
1068     cmp env (AppTy _ _) (TyVarTy _) = GT
1069
1070     cmp env (FunTy _ _) (TyVarTy _) = GT
1071     cmp env (FunTy _ _) (AppTy _ _) = GT
1072
1073     cmp env (TyConApp _ _) (TyVarTy _) = GT
1074     cmp env (TyConApp _ _) (AppTy _ _) = GT
1075     cmp env (TyConApp _ _) (FunTy _ _) = GT
1076
1077     cmp env (ForAllTy _ _) other       = GT
1078
1079     cmp env _ _                        = LT
1080
1081     cmps env []     [] = EQ
1082     cmps env (t:ts) [] = GT
1083     cmps env [] (t:ts) = LT
1084     cmps env (t1:t1s) (t2:t2s) = cmp env t1 t2 `thenCmp` cmps env t1s t2s
1085 \end{code}
1086
1087
1088 %************************************************************************
1089 %*                                                                      *
1090 \subsection{Sequencing on types
1091 %*                                                                      *
1092 %************************************************************************
1093
1094 \begin{code}
1095 seqType :: Type -> ()
1096 seqType (TyVarTy tv)      = tv `seq` ()
1097 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
1098 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
1099 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
1100 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
1101 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
1102
1103 seqTypes :: [Type] -> ()
1104 seqTypes []       = ()
1105 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
1106
1107 seqNote :: TyNote -> ()
1108 seqNote (SynNote ty)  = seqType ty
1109 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
1110 seqNote (UsgNote usg) = usg `seq` ()
1111 \end{code}
1112