compiler/types/Type.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   4 %
   5
   6 Type - public interface
   7
   8 \begin{code}
   9 {-# OPTIONS -w #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  14 -- for details
  15
  16 module Type (
  17         -- re-exports from TypeRep
  18         TyThing(..), Type, PredType(..), ThetaType,
  19         funTyCon,
  20
  21         -- Kinds
  22         Kind, SimpleKind, KindVar,
  23         kindFunResult, splitKindFunTys, splitKindFunTysN,
  24
  25         liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
  26         argTypeKindTyCon, ubxTupleKindTyCon,
  27
  28         liftedTypeKind, unliftedTypeKind, openTypeKind,
  29         argTypeKind, ubxTupleKind,
  30
  31         tySuperKind, coSuperKind,
  32
  33         isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
  34         isUbxTupleKind, isArgTypeKind, isKind, isTySuperKind,
  35         isCoSuperKind, isSuperKind, isCoercionKind, isEqPred,
  36         mkArrowKind, mkArrowKinds,
  37
  38         isSubArgTypeKind, isSubOpenTypeKind, isSubKind, defaultKind, eqKind,
  39         isSubKindCon,
  40
  41         -- Re-exports from TyCon
  42         PrimRep(..),
  43
  44         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
  45
  46         mkAppTy, mkAppTys, splitAppTy, splitAppTys,
  47         splitAppTy_maybe, repSplitAppTy_maybe,
  48
  49         mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe,
  50         splitFunTys, splitFunTysN,
  51         funResultTy, funArgTy, zipFunTys, isFunTy,
  52
  53         mkTyConApp, mkTyConTy,
  54         tyConAppTyCon, tyConAppArgs,
  55         splitTyConApp_maybe, splitTyConApp,
  56         splitNewTyConApp_maybe, splitNewTyConApp,
  57
  58         repType, repType', typePrimRep, coreView, tcView, kindView,
  59
  60         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
  61         applyTy, applyTys, isForAllTy, dropForAlls,
  62
  63         -- Source types
  64         predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, mkFamilyTyConApp,
  65
  66         -- Newtypes
  67         newTyConInstRhs,
  68
  69         -- Lifting and boxity
  70         isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
  71         isStrictType, isStrictPred,
  72
  73         -- Free variables
  74         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
  75         typeKind, addFreeTyVars,
  76
  77         -- Type families
  78         tyFamInsts,
  79
  80         -- Tidying up for printing
  81         tidyType,      tidyTypes,
  82         tidyOpenType,  tidyOpenTypes,
  83         tidyTyVarBndr, tidyFreeTyVars,
  84         tidyOpenTyVar, tidyOpenTyVars,
  85         tidyTopType,   tidyPred,
  86         tidyKind,
  87
  88         -- Comparison
  89         coreEqType, tcEqType, tcEqTypes, tcCmpType, tcCmpTypes,
  90         tcEqPred, tcCmpPred, tcEqTypeX, tcPartOfType, tcPartOfPred,
  91
  92         -- Seq
  93         seqType, seqTypes,
  94
  95         -- Type substitutions
  96         TvSubstEnv, emptyTvSubstEnv,    -- Representation widely visible
  97         TvSubst(..), emptyTvSubst,      -- Representation visible to a few friends
  98         mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
  99         getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
 100         extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
 101         isEmptyTvSubst,
 102
 103         -- Performing substitution on types
 104         substTy, substTys, substTyWith, substTheta,
 105         substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
 106
 107         -- Pretty-printing
 108         pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll,
 109         pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
 110     ) where
 111
 112 #include "HsVersions.h"
 113
 114 -- We import the representation and primitive functions from TypeRep.
 115 -- Many things are reexported, but not the representation!
 116
 117 import TypeRep
 118
 119 -- friends:
 120 import Var
 121 import VarEnv
 122 import VarSet
 123
 124 import Name
 125 import Class
 126 import PrelNames
 127 import TyCon
 128
 129 -- others
 130 import StaticFlags
 131 import Util
 132 import Outputable
 133 import UniqSet
 134
 135 import Data.List
 136 import Data.Maybe       ( isJust )
 137 \end{code}
 138
 139
 140 %************************************************************************
 141 %*                                                                      *
 142                 Type representation
 143 %*                                                                      *
 144 %************************************************************************
 145
 146 In Core, we "look through" non-recursive newtypes and PredTypes.
 147
 148 \begin{code}
 149 {-# INLINE coreView #-}
 150 coreView :: Type -> Maybe Type
 151 -- Strips off the *top layer only* of a type to give
 152 -- its underlying representation type.
 153 -- Returns Nothing if there is nothing to look through.
 154 --
 155 -- In the case of newtypes, it returns
 156 --      *either* a vanilla TyConApp (recursive newtype, or non-saturated)
 157 --      *or*     the newtype representation (otherwise), meaning the
 158 --                      type written in the RHS of the newtype decl,
 159 --                      which may itself be a newtype
 160 --
 161 -- Example: newtype R = MkR S
 162 --          newtype S = MkS T
 163 --          newtype T = MkT (T -> T)
 164 --   expandNewTcApp on R gives Just S
 165 --                  on S gives Just T
 166 --                  on T gives Nothing   (no expansion)
 167
 168 -- By being non-recursive and inlined, this case analysis gets efficiently
 169 -- joined onto the case analysis that the caller is already doing
 170 coreView (NoteTy _ ty)     = Just ty
 171 coreView (PredTy p)
 172   | isEqPred p             = Nothing
 173   | otherwise              = Just (predTypeRep p)
 174 coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys
 175                            = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
 176                                 -- Its important to use mkAppTys, rather than (foldl AppTy),
 177                                 -- because the function part might well return a
 178                                 -- partially-applied type constructor; indeed, usually will!
 179 coreView ty                = Nothing
 180
 181
 182
 183 -----------------------------------------------
 184 {-# INLINE tcView #-}
 185 tcView :: Type -> Maybe Type
 186 -- Same, but for the type checker, which just looks through synonyms
 187 tcView (NoteTy _ ty)     = Just ty
 188 tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys
 189                          = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
 190 tcView ty                = Nothing
 191
 192 -----------------------------------------------
 193 {-# INLINE kindView #-}
 194 kindView :: Kind -> Maybe Kind
 195 -- C.f. coreView, tcView
 196 -- For the moment, we don't even handle synonyms in kinds
 197 kindView (NoteTy _ k) = Just k
 198 kindView other        = Nothing
 199 \end{code}
 200
 201
 202 %************************************************************************
 203 %*                                                                      *
 204 \subsection{Constructor-specific functions}
 205 %*                                                                      *
 206 %************************************************************************
 207
 208
 209 ---------------------------------------------------------------------
 210                                 TyVarTy
 211                                 ~~~~~~~
 212 \begin{code}
 213 mkTyVarTy  :: TyVar   -> Type
 214 mkTyVarTy  = TyVarTy
 215
 216 mkTyVarTys :: [TyVar] -> [Type]
 217 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 218
 219 getTyVar :: String -> Type -> TyVar
 220 getTyVar msg ty = case getTyVar_maybe ty of
 221                     Just tv -> tv
 222                     Nothing -> panic ("getTyVar: " ++ msg)
 223
 224 isTyVarTy :: Type -> Bool
 225 isTyVarTy ty = isJust (getTyVar_maybe ty)
 226
 227 getTyVar_maybe :: Type -> Maybe TyVar
 228 getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
 229 getTyVar_maybe (TyVarTy tv)                 = Just tv
 230 getTyVar_maybe other                        = Nothing
 231
 232 \end{code}
 233
 234
 235 ---------------------------------------------------------------------
 236                                 AppTy
 237                                 ~~~~~
 238 We need to be pretty careful with AppTy to make sure we obey the
 239 invariant that a TyConApp is always visibly so.  mkAppTy maintains the
 240 invariant: use it.
 241
 242 \begin{code}
 243 mkAppTy orig_ty1 orig_ty2
 244   = mk_app orig_ty1
 245   where
 246     mk_app (NoteTy _ ty1)    = mk_app ty1
 247     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
 248     mk_app ty1               = AppTy orig_ty1 orig_ty2
 249         -- Note that the TyConApp could be an
 250         -- under-saturated type synonym.  GHC allows that; e.g.
 251         --      type Foo k = k a -> k a
 252         --      type Id x = x
 253         --      foo :: Foo Id -> Foo Id
 254         --
 255         -- Here Id is partially applied in the type sig for Foo,
 256         -- but once the type synonyms are expanded all is well
 257
 258 mkAppTys :: Type -> [Type] -> Type
 259 mkAppTys orig_ty1 []        = orig_ty1
 260         -- This check for an empty list of type arguments
 261         -- avoids the needless loss of a type synonym constructor.
 262         -- For example: mkAppTys Rational []
 263         --   returns to (Ratio Integer), which has needlessly lost
 264         --   the Rational part.
 265 mkAppTys orig_ty1 orig_tys2
 266   = mk_app orig_ty1
 267   where
 268     mk_app (NoteTy _ ty1)    = mk_app ty1
 269     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
 270                                 -- mkTyConApp: see notes with mkAppTy
 271     mk_app ty1               = foldl AppTy orig_ty1 orig_tys2
 272
 273 -------------
 274 splitAppTy_maybe :: Type -> Maybe (Type, Type)
 275 splitAppTy_maybe ty | Just ty' <- coreView ty
 276                     = splitAppTy_maybe ty'
 277 splitAppTy_maybe ty = repSplitAppTy_maybe ty
 278
 279 -------------
 280 repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
 281 -- Does the AppTy split, but assumes that any view stuff is already done
 282 repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 283 repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 284 repSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
 285                                                 Just (tys', ty') -> Just (TyConApp tc tys', ty')
 286                                                 Nothing          -> Nothing
 287 repSplitAppTy_maybe other = Nothing
 288 -------------
 289 splitAppTy :: Type -> (Type, Type)
 290 splitAppTy ty = case splitAppTy_maybe ty of
 291                         Just pr -> pr
 292                         Nothing -> panic "splitAppTy"
 293
 294 -------------
 295 splitAppTys :: Type -> (Type, [Type])
 296 splitAppTys ty = split ty ty []
 297   where
 298     split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
 299     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
 300     split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
 301     split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
 302                                                (TyConApp funTyCon [], [ty1,ty2])
 303     split orig_ty ty                    args = (orig_ty, args)
 304
 305 \end{code}
 306
 307
 308 ---------------------------------------------------------------------
 309                                 FunTy
 310                                 ~~~~~
 311
 312 \begin{code}
 313 mkFunTy :: Type -> Type -> Type
 314 mkFunTy (PredTy (EqPred ty1 ty2)) res = mkForAllTy (mkWildCoVar (PredTy (EqPred ty1 ty2))) res
 315 mkFunTy arg res = FunTy arg res
 316
 317 mkFunTys :: [Type] -> Type -> Type
 318 mkFunTys tys ty = foldr mkFunTy ty tys
 319
 320 isFunTy :: Type -> Bool
 321 isFunTy ty = isJust (splitFunTy_maybe ty)
 322
 323 splitFunTy :: Type -> (Type, Type)
 324 splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
 325 splitFunTy (FunTy arg res)   = (arg, res)
 326 splitFunTy other             = pprPanic "splitFunTy" (ppr other)
 327
 328 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 329 splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
 330 splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
 331 splitFunTy_maybe other             = Nothing
 332
 333 splitFunTys :: Type -> ([Type], Type)
 334 splitFunTys ty = split [] ty ty
 335   where
 336     split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
 337     split args orig_ty (FunTy arg res)   = split (arg:args) res res
 338     split args orig_ty ty                = (reverse args, orig_ty)
 339
 340 splitFunTysN :: Int -> Type -> ([Type], Type)
 341 -- Split off exactly n arg tys
 342 splitFunTysN 0 ty = ([], ty)
 343 splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
 344                     case splitFunTysN (n-1) res of { (args, res) ->
 345                     (arg:args, res) }}
 346
 347 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
 348 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
 349   where
 350     split acc []     nty ty                = (reverse acc, nty)
 351     split acc xs     nty ty
 352           | Just ty' <- coreView ty        = split acc xs nty ty'
 353     split acc (x:xs) nty (FunTy arg res)   = split ((x,arg):acc) xs res res
 354     split acc (x:xs) nty ty                = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
 355
 356 funResultTy :: Type -> Type
 357 funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
 358 funResultTy (FunTy arg res)   = res
 359 funResultTy ty                = pprPanic "funResultTy" (ppr ty)
 360
 361 funArgTy :: Type -> Type
 362 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
 363 funArgTy (FunTy arg res)   = arg
 364 funArgTy ty                = pprPanic "funArgTy" (ppr ty)
 365 \end{code}
 366
 367
 368 ---------------------------------------------------------------------
 369                                 TyConApp
 370                                 ~~~~~~~~
 371 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
 372 as apppropriate.
 373
 374 \begin{code}
 375 mkTyConApp :: TyCon -> [Type] -> Type
 376 mkTyConApp tycon tys
 377   | isFunTyCon tycon, [ty1,ty2] <- tys
 378   = FunTy ty1 ty2
 379
 380   | otherwise
 381   = TyConApp tycon tys
 382
 383 mkTyConTy :: TyCon -> Type
 384 mkTyConTy tycon = mkTyConApp tycon []
 385
 386 -- splitTyConApp "looks through" synonyms, because they don't
 387 -- mean a distinct type, but all other type-constructor applications
 388 -- including functions are returned as Just ..
 389
 390 tyConAppTyCon :: Type -> TyCon
 391 tyConAppTyCon ty = fst (splitTyConApp ty)
 392
 393 tyConAppArgs :: Type -> [Type]
 394 tyConAppArgs ty = snd (splitTyConApp ty)
 395
 396 splitTyConApp :: Type -> (TyCon, [Type])
 397 splitTyConApp ty = case splitTyConApp_maybe ty of
 398                         Just stuff -> stuff
 399                         Nothing    -> pprPanic "splitTyConApp" (ppr ty)
 400
 401 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 402 splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
 403 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 404 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 405 splitTyConApp_maybe other             = Nothing
 406
 407 -- Sometimes we do NOT want to look throught a newtype.  When case matching
 408 -- on a newtype we want a convenient way to access the arguments of a newty
 409 -- constructor so as to properly form a coercion.
 410 splitNewTyConApp :: Type -> (TyCon, [Type])
 411 splitNewTyConApp ty = case splitNewTyConApp_maybe ty of
 412                         Just stuff -> stuff
 413                         Nothing    -> pprPanic "splitNewTyConApp" (ppr ty)
 414 splitNewTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 415 splitNewTyConApp_maybe ty | Just ty' <- tcView ty = splitNewTyConApp_maybe ty'
 416 splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 417 splitNewTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 418 splitNewTyConApp_maybe other          = Nothing
 419
 420 newTyConInstRhs :: TyCon -> [Type] -> Type
 421 -- Unwrap one 'layer' of newtype
 422 -- Use the eta'd version if possible
 423 newTyConInstRhs tycon tys
 424     = ASSERT2( equalLength tvs tys1, ppr tycon $$ ppr tys $$ ppr tvs )
 425       mkAppTys (substTyWith tvs tys1 ty) tys2
 426   where
 427     (tvs, ty)    = newTyConEtadRhs tycon
 428     (tys1, tys2) = splitAtList tvs tys
 429 \end{code}
 430
 431
 432 ---------------------------------------------------------------------
 433                                 SynTy
 434                                 ~~~~~
 435
 436 Notes on type synonyms
 437 ~~~~~~~~~~~~~~~~~~~~~~
 438 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
 439 to return type synonyms whereever possible. Thus
 440
 441         type Foo a = a -> a
 442
 443 we want
 444         splitFunTys (a -> Foo a) = ([a], Foo a)
 445 not                                ([a], a -> a)
 446
 447 The reason is that we then get better (shorter) type signatures in
 448 interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 449
 450
 451                 Representation types
 452                 ~~~~~~~~~~~~~~~~~~~~
 453 repType looks through
 454         (a) for-alls, and
 455         (b) synonyms
 456         (c) predicates
 457         (d) usage annotations
 458         (e) all newtypes, including recursive ones, but not newtype families
 459 It's useful in the back end.
 460
 461 \begin{code}
 462 repType :: Type -> Type
 463 -- Only applied to types of kind *; hence tycons are saturated
 464 repType ty | Just ty' <- coreView ty = repType ty'
 465 repType (ForAllTy _ ty)  = repType ty
 466 repType (TyConApp tc tys)
 467   | isNewTyCon tc
 468   , (tvs, rep_ty) <- newTyConRep tc
 469   = -- Recursive newtypes are opaque to coreView
 470     -- but we must expand them here.  Sure to
 471     -- be saturated because repType is only applied
 472     -- to types of kind *
 473     ASSERT( tys `lengthIs` tyConArity tc )
 474     repType (substTyWith tvs tys rep_ty)
 475
 476 repType ty = ty
 477
 478 -- repType' aims to be a more thorough version of repType
 479 -- For now it simply looks through the TyConApp args too
 480 repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
 481             | otherwise = go1 ty
 482  where
 483         go1 = go . repType
 484         go (TyConApp tc tys) = mkTyConApp tc (map repType' tys)
 485         go ty = ty
 486
 487
 488 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 489 -- of inspecting the type directly.
 490 typePrimRep :: Type -> PrimRep
 491 typePrimRep ty = case repType ty of
 492                    TyConApp tc _ -> tyConPrimRep tc
 493                    FunTy _ _     -> PtrRep
 494                    AppTy _ _     -> PtrRep      -- See note below
 495                    TyVarTy _     -> PtrRep
 496                    other         -> pprPanic "typePrimRep" (ppr ty)
 497         -- Types of the form 'f a' must be of kind *, not *#, so
 498         -- we are guaranteed that they are represented by pointers.
 499         -- The reason is that f must have kind *->*, not *->*#, because
 500         -- (we claim) there is no way to constrain f's kind any other
 501         -- way.
 502 \end{code}
 503
 504
 505 ---------------------------------------------------------------------
 506                                 ForAllTy
 507                                 ~~~~~~~~
 508
 509 \begin{code}
 510 mkForAllTy :: TyVar -> Type -> Type
 511 mkForAllTy tyvar ty
 512   = mkForAllTys [tyvar] ty
 513
 514 mkForAllTys :: [TyVar] -> Type -> Type
 515 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 516
 517 isForAllTy :: Type -> Bool
 518 isForAllTy (NoteTy _ ty)  = isForAllTy ty
 519 isForAllTy (ForAllTy _ _) = True
 520 isForAllTy other_ty       = False
 521
 522 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 523 splitForAllTy_maybe ty = splitFAT_m ty
 524   where
 525     splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
 526     splitFAT_m (ForAllTy tyvar ty)          = Just(tyvar, ty)
 527     splitFAT_m _                            = Nothing
 528
 529 splitForAllTys :: Type -> ([TyVar], Type)
 530 splitForAllTys ty = split ty ty []
 531    where
 532      split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
 533      split orig_ty (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
 534      split orig_ty t                 tvs = (reverse tvs, orig_ty)
 535
 536 dropForAlls :: Type -> Type
 537 dropForAlls ty = snd (splitForAllTys ty)
 538 \end{code}
 539
 540 -- (mkPiType now in CoreUtils)
 541
 542 applyTy, applyTys
 543 ~~~~~~~~~~~~~~~~~
 544 Instantiate a for-all type with one or more type arguments.
 545 Used when we have a polymorphic function applied to type args:
 546         f t1 t2
 547 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
 548 the expression.
 549
 550 \begin{code}
 551 applyTy :: Type -> Type -> Type
 552 applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
 553 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
 554 applyTy other            arg = panic "applyTy"
 555
 556 applyTys :: Type -> [Type] -> Type
 557 -- This function is interesting because
 558 --      a) the function may have more for-alls than there are args
 559 --      b) less obviously, it may have fewer for-alls
 560 -- For case (b) think of
 561 --      applyTys (forall a.a) [forall b.b, Int]
 562 -- This really can happen, via dressing up polymorphic types with newtype
 563 -- clothing.  Here's an example:
 564 --      newtype R = R (forall a. a->a)
 565 --      foo = case undefined :: R of
 566 --              R f -> f ()
 567
 568 applyTys orig_fun_ty []      = orig_fun_ty
 569 applyTys orig_fun_ty arg_tys
 570   | n_tvs == n_args     -- The vastly common case
 571   = substTyWith tvs arg_tys rho_ty
 572   | n_tvs > n_args      -- Too many for-alls
 573   = substTyWith (take n_args tvs) arg_tys
 574                 (mkForAllTys (drop n_args tvs) rho_ty)
 575   | otherwise           -- Too many type args
 576   = ASSERT2( n_tvs > 0, ppr orig_fun_ty )       -- Zero case gives infnite loop!
 577     applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
 578              (drop n_tvs arg_tys)
 579   where
 580     (tvs, rho_ty) = splitForAllTys orig_fun_ty
 581     n_tvs = length tvs
 582     n_args = length arg_tys
 583 \end{code}
 584
 585
 586 %************************************************************************
 587 %*                                                                      *
 588 \subsection{Source types}
 589 %*                                                                      *
 590 %************************************************************************
 591
 592 A "source type" is a type that is a separate type as far as the type checker is
 593 concerned, but which has low-level representation as far as the back end is concerned.
 594
 595 Source types are always lifted.
 596
 597 The key function is predTypeRep which gives the representation of a source type:
 598
 599 \begin{code}
 600 mkPredTy :: PredType -> Type
 601 mkPredTy pred = PredTy pred
 602
 603 mkPredTys :: ThetaType -> [Type]
 604 mkPredTys preds = map PredTy preds
 605
 606 predTypeRep :: PredType -> Type
 607 -- Convert a PredType to its "representation type";
 608 -- the post-type-checking type used by all the Core passes of GHC.
 609 -- Unwraps only the outermost level; for example, the result might
 610 -- be a newtype application
 611 predTypeRep (IParam _ ty)     = ty
 612 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 613         -- Result might be a newtype application, but the consumer will
 614         -- look through that too if necessary
 615 predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2))
 616
 617 mkFamilyTyConApp :: TyCon -> [Type] -> Type
 618 -- Given a family instance TyCon and its arg types, return the
 619 -- corresponding family type.  E.g.
 620 --      data family T a
 621 --      data instance T (Maybe b) = MkT b       -- Instance tycon :RTL
 622 -- Then
 623 --      mkFamilyTyConApp :RTL Int  =  T (Maybe Int)
 624 mkFamilyTyConApp tc tys
 625   | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
 626   , let fam_subst = zipTopTvSubst (tyConTyVars tc) tys
 627   = mkTyConApp fam_tc (substTys fam_subst fam_tys)
 628   | otherwise
 629   = mkTyConApp tc tys
 630
 631 -- Pretty prints a tycon, using the family instance in case of a
 632 -- representation tycon.  For example
 633 --      e.g.  data T [a] = ...
 634 -- In that case we want to print `T [a]', where T is the family TyCon
 635 pprSourceTyCon tycon
 636   | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
 637   = ppr $ fam_tc `TyConApp` tys        -- can't be FunTyCon
 638   | otherwise
 639   = ppr tycon
 640 \end{code}
 641
 642
 643 %************************************************************************
 644 %*                                                                      *
 645 \subsection{Kinds and free variables}
 646 %*                                                                      *
 647 %************************************************************************
 648
 649 ---------------------------------------------------------------------
 650                 Finding the kind of a type
 651                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 652 \begin{code}
 653 typeKind :: Type -> Kind
 654 typeKind (TyConApp tycon tys) = ASSERT( not (isCoercionTyCon tycon) )
 655                                    -- We should be looking for the coercion kind,
 656                                    -- not the type kind
 657                                 foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 658 typeKind (NoteTy _ ty)        = typeKind ty
 659 typeKind (PredTy pred)        = predKind pred
 660 typeKind (AppTy fun arg)      = kindFunResult (typeKind fun)
 661 typeKind (ForAllTy tv ty)     = typeKind ty
 662 typeKind (TyVarTy tyvar)      = tyVarKind tyvar
 663 typeKind (FunTy arg res)
 664     -- Hack alert.  The kind of (Int -> Int#) is liftedTypeKind (*),
 665     --              not unliftedTypKind (#)
 666     -- The only things that can be after a function arrow are
 667     --   (a) types (of kind openTypeKind or its sub-kinds)
 668     --   (b) kinds (of super-kind TY) (e.g. * -> (* -> *))
 669     | isTySuperKind k         = k
 670     | otherwise               = ASSERT( isSubOpenTypeKind k) liftedTypeKind
 671     where
 672       k = typeKind res
 673
 674 predKind :: PredType -> Kind
 675 predKind (EqPred {}) = coSuperKind      -- A coercion kind!
 676 predKind (ClassP {}) = liftedTypeKind   -- Class and implicitPredicates are
 677 predKind (IParam {}) = liftedTypeKind   -- always represented by lifted types
 678 \end{code}
 679
 680
 681 ---------------------------------------------------------------------
 682                 Free variables of a type
 683                 ~~~~~~~~~~~~~~~~~~~~~~~~
 684 \begin{code}
 685 tyVarsOfType :: Type -> TyVarSet
 686 -- NB: for type synonyms tyVarsOfType does *not* expand the synonym
 687 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 688 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 689 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 690 tyVarsOfType (PredTy sty)               = tyVarsOfPred sty
 691 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 692 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 693 tyVarsOfType (ForAllTy tyvar ty)        = delVarSet (tyVarsOfType ty) tyvar
 694
 695 tyVarsOfTypes :: [Type] -> TyVarSet
 696 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 697
 698 tyVarsOfPred :: PredType -> TyVarSet
 699 tyVarsOfPred (IParam _ ty)    = tyVarsOfType ty
 700 tyVarsOfPred (ClassP _ tys)   = tyVarsOfTypes tys
 701 tyVarsOfPred (EqPred ty1 ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
 702
 703 tyVarsOfTheta :: ThetaType -> TyVarSet
 704 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
 705
 706 -- Add a Note with the free tyvars to the top of the type
 707 addFreeTyVars :: Type -> Type
 708 addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
 709 addFreeTyVars ty                             = NoteTy (FTVNote (tyVarsOfType ty)) ty
 710 \end{code}
 711
 712
 713 %************************************************************************
 714 %*                                                                      *
 715 \subsection{Type families}
 716 %*                                                                      *
 717 %************************************************************************
 718
 719 Type family instances occuring in a type after expanding synonyms.
 720
 721 \begin{code}
 722 tyFamInsts :: Type -> [(TyCon, [Type])]
 723 tyFamInsts ty
 724   | Just exp_ty <- tcView ty    = tyFamInsts exp_ty
 725 tyFamInsts (TyVarTy _)          = []
 726 tyFamInsts (TyConApp tc tys)
 727   | isOpenSynTyCon tc           = [(tc, tys)]
 728   | otherwise                   = concat (map tyFamInsts tys)
 729 tyFamInsts (FunTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
 730 tyFamInsts (AppTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
 731 tyFamInsts (ForAllTy _ ty)      = tyFamInsts ty
 732 \end{code}
 733
 734
 735 %************************************************************************
 736 %*                                                                      *
 737 \subsection{TidyType}
 738 %*                                                                      *
 739 %************************************************************************
 740
 741 tidyTy tidies up a type for printing in an error message, or in
 742 an interface file.
 743
 744 It doesn't change the uniques at all, just the print names.
 745
 746 \begin{code}
 747 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 748 tidyTyVarBndr env@(tidy_env, subst) tyvar
 749   = case tidyOccName tidy_env (getOccName name) of
 750       (tidy', occ') -> ((tidy', subst'), tyvar'')
 751         where
 752           subst' = extendVarEnv subst tyvar tyvar''
 753           tyvar' = setTyVarName tyvar name'
 754           name'  = tidyNameOcc name occ'
 755                 -- Don't forget to tidy the kind for coercions!
 756           tyvar'' | isCoVar tyvar = setTyVarKind tyvar' kind'
 757                   | otherwise     = tyvar'
 758           kind'  = tidyType env (tyVarKind tyvar)
 759   where
 760     name = tyVarName tyvar
 761
 762 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 763 -- Add the free tyvars to the env in tidy form,
 764 -- so that we can tidy the type they are free in
 765 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 766
 767 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 768 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 769
 770 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 771 -- Treat a new tyvar as a binder, and give it a fresh tidy name
 772 tidyOpenTyVar env@(tidy_env, subst) tyvar
 773   = case lookupVarEnv subst tyvar of
 774         Just tyvar' -> (env, tyvar')            -- Already substituted
 775         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 776
 777 tidyType :: TidyEnv -> Type -> Type
 778 tidyType env@(tidy_env, subst) ty
 779   = go ty
 780   where
 781     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 782                                 Nothing  -> TyVarTy tv
 783                                 Just tv' -> TyVarTy tv'
 784     go (TyConApp tycon tys) = let args = map go tys
 785                               in args `seqList` TyConApp tycon args
 786     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 787     go (PredTy sty)         = PredTy (tidyPred env sty)
 788     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 789     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 790     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 791                               where
 792                                 (envp, tvp) = tidyTyVarBndr env tv
 793
 794     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 795
 796 tidyTypes env tys = map (tidyType env) tys
 797
 798 tidyPred :: TidyEnv -> PredType -> PredType
 799 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 800 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 801 tidyPred env (EqPred ty1 ty2)  = EqPred (tidyType env ty1) (tidyType env ty2)
 802 \end{code}
 803
 804
 805 @tidyOpenType@ grabs the free type variables, tidies them
 806 and then uses @tidyType@ to work over the type itself
 807
 808 \begin{code}
 809 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 810 tidyOpenType env ty
 811   = (env', tidyType env' ty)
 812   where
 813     env' = tidyFreeTyVars env (tyVarsOfType ty)
 814
 815 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 816 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 817
 818 tidyTopType :: Type -> Type
 819 tidyTopType ty = tidyType emptyTidyEnv ty
 820 \end{code}
 821
 822 \begin{code}
 823
 824 tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
 825 tidyKind env k = tidyOpenType env k
 826
 827 \end{code}
 828
 829
 830 %************************************************************************
 831 %*                                                                      *
 832 \subsection{Liftedness}
 833 %*                                                                      *
 834 %************************************************************************
 835
 836 \begin{code}
 837 isUnLiftedType :: Type -> Bool
 838         -- isUnLiftedType returns True for forall'd unlifted types:
 839         --      x :: forall a. Int#
 840         -- I found bindings like these were getting floated to the top level.
 841         -- They are pretty bogus types, mind you.  It would be better never to
 842         -- construct them
 843
 844 isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
 845 isUnLiftedType (ForAllTy tv ty)  = isUnLiftedType ty
 846 isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
 847 isUnLiftedType other             = False
 848
 849 isUnboxedTupleType :: Type -> Bool
 850 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 851                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
 852                            other              -> False
 853
 854 -- Should only be applied to *types*; hence the assert
 855 isAlgType :: Type -> Bool
 856 isAlgType ty = case splitTyConApp_maybe ty of
 857                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 858                                               isAlgTyCon tc
 859                         other              -> False
 860 \end{code}
 861
 862 @isStrictType@ computes whether an argument (or let RHS) should
 863 be computed strictly or lazily, based only on its type.
 864 Works just like isUnLiftedType, except that it has a special case
 865 for dictionaries.  Since it takes account of ClassP, you might think
 866 this function should be in TcType, but isStrictType is used by DataCon,
 867 which is below TcType in the hierarchy, so it's convenient to put it here.
 868
 869 \begin{code}
 870 isStrictType (PredTy pred)     = isStrictPred pred
 871 isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
 872 isStrictType (ForAllTy tv ty)  = isStrictType ty
 873 isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
 874 isStrictType other             = False
 875
 876 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
 877 isStrictPred other           = False
 878         -- We may be strict in dictionary types, but only if it
 879         -- has more than one component.
 880         -- [Being strict in a single-component dictionary risks
 881         --  poking the dictionary component, which is wrong.]
 882 \end{code}
 883
 884 \begin{code}
 885 isPrimitiveType :: Type -> Bool
 886 -- Returns types that are opaque to Haskell.
 887 -- Most of these are unlifted, but now that we interact with .NET, we
 888 -- may have primtive (foreign-imported) types that are lifted
 889 isPrimitiveType ty = case splitTyConApp_maybe ty of
 890                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 891                                               isPrimTyCon tc
 892                         other              -> False
 893 \end{code}
 894
 895
 896 %************************************************************************
 897 %*                                                                      *
 898 \subsection{Sequencing on types
 899 %*                                                                      *
 900 %************************************************************************
 901
 902 \begin{code}
 903 seqType :: Type -> ()
 904 seqType (TyVarTy tv)      = tv `seq` ()
 905 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
 906 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
 907 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
 908 seqType (PredTy p)        = seqPred p
 909 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
 910 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
 911
 912 seqTypes :: [Type] -> ()
 913 seqTypes []       = ()
 914 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 915
 916 seqNote :: TyNote -> ()
 917 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 918
 919 seqPred :: PredType -> ()
 920 seqPred (ClassP c tys)   = c `seq` seqTypes tys
 921 seqPred (IParam n ty)    = n `seq` seqType ty
 922 seqPred (EqPred ty1 ty2) = seqType ty1 `seq` seqType ty2
 923 \end{code}
 924
 925
 926 %************************************************************************
 927 %*                                                                      *
 928                 Equality for Core types
 929         (We don't use instances so that we know where it happens)
 930 %*                                                                      *
 931 %************************************************************************
 932
 933 Note that eqType works right even for partial applications of newtypes.
 934 See Note [Newtype eta] in TyCon.lhs
 935
 936 \begin{code}
 937 coreEqType :: Type -> Type -> Bool
 938 coreEqType t1 t2
 939   = eq rn_env t1 t2
 940   where
 941     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
 942
 943     eq env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
 944     eq env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = eq (rnBndr2 env tv1 tv2) t1 t2
 945     eq env (AppTy s1 t1)       (AppTy s2 t2)     = eq env s1 s2 && eq env t1 t2
 946     eq env (FunTy s1 t1)       (FunTy s2 t2)     = eq env s1 s2 && eq env t1 t2
 947     eq env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
 948         | tc1 == tc2, all2 (eq env) tys1 tys2 = True
 949                         -- The lengths should be equal because
 950                         -- the two types have the same kind
 951         -- NB: if the type constructors differ that does not
 952         --     necessarily mean that the types aren't equal
 953         --     (synonyms, newtypes)
 954         -- Even if the type constructors are the same, but the arguments
 955         -- differ, the two types could be the same (e.g. if the arg is just
 956         -- ignored in the RHS).  In both these cases we fall through to an
 957         -- attempt to expand one side or the other.
 958
 959         -- Now deal with newtypes, synonyms, pred-tys
 960     eq env t1 t2 | Just t1' <- coreView t1 = eq env t1' t2
 961                  | Just t2' <- coreView t2 = eq env t1 t2'
 962
 963         -- Fall through case; not equal!
 964     eq env t1 t2 = False
 965 \end{code}
 966
 967
 968 %************************************************************************
 969 %*                                                                      *
 970                 Comparision for source types
 971         (We don't use instances so that we know where it happens)
 972 %*                                                                      *
 973 %************************************************************************
 974
 975 Note that
 976         tcEqType, tcCmpType
 977 do *not* look through newtypes, PredTypes
 978
 979 \begin{code}
 980 tcEqType :: Type -> Type -> Bool
 981 tcEqType t1 t2 = isEqual $ cmpType t1 t2
 982
 983 tcEqTypes :: [Type] -> [Type] -> Bool
 984 tcEqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2
 985
 986 tcCmpType :: Type -> Type -> Ordering
 987 tcCmpType t1 t2 = cmpType t1 t2
 988
 989 tcCmpTypes :: [Type] -> [Type] -> Ordering
 990 tcCmpTypes tys1 tys2 = cmpTypes tys1 tys2
 991
 992 tcEqPred :: PredType -> PredType -> Bool
 993 tcEqPred p1 p2 = isEqual $ cmpPred p1 p2
 994
 995 tcCmpPred :: PredType -> PredType -> Ordering
 996 tcCmpPred p1 p2 = cmpPred p1 p2
 997
 998 tcEqTypeX :: RnEnv2 -> Type -> Type -> Bool
 999 tcEqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2
1000 \end{code}
1001
1002 Checks whether the second argument is a subterm of the first.  (We don't care
1003 about binders, as we are only interested in syntactic subterms.)
1004
1005 \begin{code}
1006 tcPartOfType :: Type -> Type -> Bool
1007 tcPartOfType t1              t2 = tcEqType t1 t2
1008 tcPartOfType t1              t2
1009   | Just t2' <- tcView t2       = tcPartOfType t1 t2'
1010 tcPartOfType t1 (ForAllTy _ t2) = tcPartOfType t1 t2
1011 tcPartOfType t1 (AppTy s2 t2)   = tcPartOfType t1 s2 || tcPartOfType t1 t2
1012 tcPartOfType t1 (FunTy s2 t2)   = tcPartOfType t1 s2 || tcPartOfType t1 t2
1013 tcPartOfType t1 (PredTy p2)     = tcPartOfPred t1 p2
1014 tcPartOfType t1 (TyConApp _ ts) = any (tcPartOfType t1) ts
1015 tcPartOfType t1 (NoteTy _ t2)   = tcPartOfType t1 t2
1016
1017 tcPartOfPred :: Type -> PredType -> Bool
1018 tcPartOfPred t1 (IParam _ t2)  = tcPartOfType t1 t2
1019 tcPartOfPred t1 (ClassP _ ts)  = any (tcPartOfType t1) ts
1020 tcPartOfPred t1 (EqPred s2 t2) = tcPartOfType t1 s2 || tcPartOfType t1 t2
1021 \end{code}
1022
1023 Now here comes the real worker
1024
1025 \begin{code}
1026 cmpType :: Type -> Type -> Ordering
1027 cmpType t1 t2 = cmpTypeX rn_env t1 t2
1028   where
1029     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
1030
1031 cmpTypes :: [Type] -> [Type] -> Ordering
1032 cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
1033   where
1034     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
1035
1036 cmpPred :: PredType -> PredType -> Ordering
1037 cmpPred p1 p2 = cmpPredX rn_env p1 p2
1038   where
1039     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
1040
1041 cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering  -- Main workhorse
1042 cmpTypeX env t1 t2 | Just t1' <- tcView t1 = cmpTypeX env t1' t2
1043                    | Just t2' <- tcView t2 = cmpTypeX env t1 t2'
1044
1045 cmpTypeX env (TyVarTy tv1)       (TyVarTy tv2)       = rnOccL env tv1 `compare` rnOccR env tv2
1046 cmpTypeX env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
1047 cmpTypeX env (AppTy s1 t1)       (AppTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
1048 cmpTypeX env (FunTy s1 t1)       (FunTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
1049 cmpTypeX env (PredTy p1)         (PredTy p2)         = cmpPredX env p1 p2
1050 cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
1051 cmpTypeX env t1                 (NoteTy _ t2)        = cmpTypeX env t1 t2
1052
1053     -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy
1054 cmpTypeX env (AppTy _ _) (TyVarTy _) = GT
1055
1056 cmpTypeX env (FunTy _ _) (TyVarTy _) = GT
1057 cmpTypeX env (FunTy _ _) (AppTy _ _) = GT
1058
1059 cmpTypeX env (TyConApp _ _) (TyVarTy _) = GT
1060 cmpTypeX env (TyConApp _ _) (AppTy _ _) = GT
1061 cmpTypeX env (TyConApp _ _) (FunTy _ _) = GT
1062
1063 cmpTypeX env (ForAllTy _ _) (TyVarTy _)    = GT
1064 cmpTypeX env (ForAllTy _ _) (AppTy _ _)    = GT
1065 cmpTypeX env (ForAllTy _ _) (FunTy _ _)    = GT
1066 cmpTypeX env (ForAllTy _ _) (TyConApp _ _) = GT
1067
1068 cmpTypeX env (PredTy _)   t2            = GT
1069
1070 cmpTypeX env _ _ = LT
1071
1072 -------------
1073 cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
1074 cmpTypesX env []        []        = EQ
1075 cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 `thenCmp` cmpTypesX env tys1 tys2
1076 cmpTypesX env []        tys       = LT
1077 cmpTypesX env ty        []        = GT
1078
1079 -------------
1080 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
1081 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
1082         -- Compare names only for implicit parameters
1083         -- This comparison is used exclusively (I believe)
1084         -- for the Avails finite map built in TcSimplify
1085         -- If the types differ we keep them distinct so that we see
1086         -- a distinct pair to run improvement on
1087 cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
1088 cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
1089
1090 -- Constructor order: IParam < ClassP < EqPred
1091 cmpPredX env (IParam {})     _              = LT
1092 cmpPredX env (ClassP {})    (IParam {})     = GT
1093 cmpPredX env (ClassP {})    (EqPred {})     = LT
1094 cmpPredX env (EqPred {})    _               = GT
1095 \end{code}
1096
1097 PredTypes are used as a FM key in TcSimplify,
1098 so we take the easy path and make them an instance of Ord
1099
1100 \begin{code}
1101 instance Eq  PredType where { (==)    = tcEqPred }
1102 instance Ord PredType where { compare = tcCmpPred }
1103 \end{code}
1104
1105
1106 %************************************************************************
1107 %*                                                                      *
1108                 Type substitutions
1109 %*                                                                      *
1110 %************************************************************************
1111
1112 \begin{code}
1113 data TvSubst
1114   = TvSubst InScopeSet  -- The in-scope type variables
1115             TvSubstEnv  -- The substitution itself
1116         -- See Note [Apply Once]
1117         -- and Note [Extending the TvSubstEnv]
1118
1119 {- ----------------------------------------------------------
1120
1121 Note [Apply Once]
1122 ~~~~~~~~~~~~~~~~~
1123 We use TvSubsts to instantiate things, and we might instantiate
1124         forall a b. ty
1125 \with the types
1126         [a, b], or [b, a].
1127 So the substition might go [a->b, b->a].  A similar situation arises in Core
1128 when we find a beta redex like
1129         (/\ a /\ b -> e) b a
1130 Then we also end up with a substition that permutes type variables. Other
1131 variations happen to; for example [a -> (a, b)].
1132
1133         ***************************************************
1134         *** So a TvSubst must be applied precisely once ***
1135         ***************************************************
1136
1137 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
1138 we use during unifications, it must not be repeatedly applied.
1139
1140 Note [Extending the TvSubst]
1141 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1142 The following invariant should hold of a TvSubst
1143
1144         The in-scope set is needed *only* to
1145         guide the generation of fresh uniques
1146
1147         In particular, the *kind* of the type variables in
1148         the in-scope set is not relevant
1149
1150 This invariant allows a short-cut when the TvSubstEnv is empty:
1151 if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds ---
1152 then (substTy subst ty) does nothing.
1153
1154 For example, consider:
1155         (/\a. /\b:(a~Int). ...b..) Int
1156 We substitute Int for 'a'.  The Unique of 'b' does not change, but
1157 nevertheless we add 'b' to the TvSubstEnv, because b's type does change
1158
1159 This invariant has several crucial consequences:
1160
1161 * In substTyVarBndr, we need extend the TvSubstEnv
1162         - if the unique has changed
1163         - or if the kind has changed
1164
1165 * In substTyVar, we do not need to consult the in-scope set;
1166   the TvSubstEnv is enough
1167
1168 * In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty
1169
1170
1171 -------------------------------------------------------------- -}
1172
1173
1174 type TvSubstEnv = TyVarEnv Type
1175         -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
1176         -- invariant discussed in Note [Apply Once]), and also independently
1177         -- in the middle of matching, and unification (see Types.Unify)
1178         -- So you have to look at the context to know if it's idempotent or
1179         -- apply-once or whatever
1180 emptyTvSubstEnv :: TvSubstEnv
1181 emptyTvSubstEnv = emptyVarEnv
1182
1183 composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
1184 -- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
1185 -- It assumes that both are idempotent
1186 -- Typically, env1 is the refinement to a base substitution env2
1187 composeTvSubst in_scope env1 env2
1188   = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
1189         -- First apply env1 to the range of env2
1190         -- Then combine the two, making sure that env1 loses if
1191         -- both bind the same variable; that's why env1 is the
1192         --  *left* argument to plusVarEnv, because the right arg wins
1193   where
1194     subst1 = TvSubst in_scope env1
1195
1196 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
1197
1198 isEmptyTvSubst :: TvSubst -> Bool
1199          -- See Note [Extending the TvSubstEnv]
1200 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
1201
1202 mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
1203 mkTvSubst = TvSubst
1204
1205 getTvSubstEnv :: TvSubst -> TvSubstEnv
1206 getTvSubstEnv (TvSubst _ env) = env
1207
1208 getTvInScope :: TvSubst -> InScopeSet
1209 getTvInScope (TvSubst in_scope _) = in_scope
1210
1211 isInScope :: Var -> TvSubst -> Bool
1212 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
1213
1214 notElemTvSubst :: TyVar -> TvSubst -> Bool
1215 notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
1216
1217 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
1218 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
1219
1220 extendTvInScope :: TvSubst -> [Var] -> TvSubst
1221 extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
1222
1223 extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
1224 extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
1225
1226 extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
1227 extendTvSubstList (TvSubst in_scope env) tvs tys
1228   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
1229
1230 -- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
1231 -- the types given; but it's just a thunk so with a bit of luck
1232 -- it'll never be evaluated
1233
1234 mkOpenTvSubst :: TvSubstEnv -> TvSubst
1235 mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
1236
1237 zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
1238 zipOpenTvSubst tyvars tys
1239 #ifdef DEBUG
1240   | length tyvars /= length tys
1241   = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1242   | otherwise
1243 #endif
1244   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
1245
1246 -- mkTopTvSubst is called when doing top-level substitutions.
1247 -- Here we expect that the free vars of the range of the
1248 -- substitution will be empty.
1249 mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
1250 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
1251
1252 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
1253 zipTopTvSubst tyvars tys
1254 #ifdef DEBUG
1255   | length tyvars /= length tys
1256   = pprTrace "zipTopTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1257   | otherwise
1258 #endif
1259   = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
1260
1261 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
1262 zipTyEnv tyvars tys
1263 #ifdef DEBUG
1264   | length tyvars /= length tys
1265   = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
1266   | otherwise
1267 #endif
1268   = zip_ty_env tyvars tys emptyVarEnv
1269
1270 -- Later substitutions in the list over-ride earlier ones,
1271 -- but there should be no loops
1272 zip_ty_env []       []       env = env
1273 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
1274         -- There used to be a special case for when
1275         --      ty == TyVarTy tv
1276         -- (a not-uncommon case) in which case the substitution was dropped.
1277         -- But the type-tidier changes the print-name of a type variable without
1278         -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had
1279         -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.
1280         -- And it happened that t was the type variable of the class.  Post-tiding,
1281         -- it got turned into {Foo t2}.  The ext-core printer expanded this using
1282         -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
1283         -- and so generated a rep type mentioning t not t2.
1284         --
1285         -- Simplest fix is to nuke the "optimisation"
1286 zip_ty_env tvs      tys      env   = pprTrace "Var/Type length mismatch: " (ppr tvs $$ ppr tys) env
1287 -- zip_ty_env _ _ env = env
1288
1289 instance Outputable TvSubst where
1290   ppr (TvSubst ins env)
1291     = brackets $ sep[ ptext SLIT("TvSubst"),
1292                       nest 2 (ptext SLIT("In scope:") <+> ppr ins),
1293                       nest 2 (ptext SLIT("Env:") <+> ppr env) ]
1294 \end{code}
1295
1296 %************************************************************************
1297 %*                                                                      *
1298                 Performing type substitutions
1299 %*                                                                      *
1300 %************************************************************************
1301
1302 \begin{code}
1303 substTyWith :: [TyVar] -> [Type] -> Type -> Type
1304 substTyWith tvs tys = ASSERT( length tvs == length tys )
1305                       substTy (zipOpenTvSubst tvs tys)
1306
1307 substTy :: TvSubst -> Type  -> Type
1308 substTy subst ty | isEmptyTvSubst subst = ty
1309                  | otherwise            = subst_ty subst ty
1310
1311 substTys :: TvSubst -> [Type] -> [Type]
1312 substTys subst tys | isEmptyTvSubst subst = tys
1313                    | otherwise            = map (subst_ty subst) tys
1314
1315 substTheta :: TvSubst -> ThetaType -> ThetaType
1316 substTheta subst theta
1317   | isEmptyTvSubst subst = theta
1318   | otherwise            = map (substPred subst) theta
1319
1320 substPred :: TvSubst -> PredType -> PredType
1321 substPred subst (IParam n ty)     = IParam n (subst_ty subst ty)
1322 substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
1323 substPred subst (EqPred ty1 ty2)  = EqPred (subst_ty subst ty1) (subst_ty subst ty2)
1324
1325 deShadowTy :: TyVarSet -> Type -> Type  -- Remove any nested binders mentioning tvs
1326 deShadowTy tvs ty
1327   = subst_ty (mkTvSubst in_scope emptyTvSubstEnv) ty
1328   where
1329     in_scope = mkInScopeSet tvs
1330
1331 subst_ty :: TvSubst -> Type -> Type
1332 -- subst_ty is the main workhorse for type substitution
1333 --
1334 -- Note that the in_scope set is poked only if we hit a forall
1335 -- so it may often never be fully computed
1336 subst_ty subst ty
1337    = go ty
1338   where
1339     go (TyVarTy tv)                = substTyVar subst tv
1340     go (TyConApp tc tys)           = let args = map go tys
1341                                      in  args `seqList` TyConApp tc args
1342
1343     go (PredTy p)                  = PredTy $! (substPred subst p)
1344
1345     go (NoteTy (FTVNote _) ty2)    = go ty2             -- Discard the free tyvar note
1346
1347     go (FunTy arg res)             = (FunTy $! (go arg)) $! (go res)
1348     go (AppTy fun arg)             = mkAppTy (go fun) $! (go arg)
1349                 -- The mkAppTy smart constructor is important
1350                 -- we might be replacing (a Int), represented with App
1351                 -- by [Int], represented with TyConApp
1352     go (ForAllTy tv ty)            = case substTyVarBndr subst tv of
1353                                         (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
1354
1355 substTyVar :: TvSubst -> TyVar  -> Type
1356 substTyVar subst@(TvSubst in_scope env) tv
1357   = case lookupTyVar subst tv of {
1358         Nothing -> TyVarTy tv;
1359         Just ty -> ty   -- See Note [Apply Once]
1360     }
1361
1362 substTyVars :: TvSubst -> [TyVar] -> [Type]
1363 substTyVars subst tvs = map (substTyVar subst) tvs
1364
1365 lookupTyVar :: TvSubst -> TyVar  -> Maybe Type
1366         -- See Note [Extending the TvSubst]
1367 lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv
1368
1369 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)
1370 substTyVarBndr subst@(TvSubst in_scope env) old_var
1371   = (TvSubst (in_scope `extendInScopeSet` new_var) new_env, new_var)
1372   where
1373     is_co_var = isCoVar old_var
1374
1375     new_env | no_change = delVarEnv env old_var
1376             | otherwise = extendVarEnv env old_var (TyVarTy new_var)
1377
1378     no_change = new_var == old_var && not is_co_var
1379         -- no_change means that the new_var is identical in
1380         -- all respects to the old_var (same unique, same kind)
1381         -- See Note [Extending the TvSubst]
1382         --
1383         -- In that case we don't need to extend the substitution
1384         -- to map old to new.  But instead we must zap any
1385         -- current substitution for the variable. For example:
1386         --      (\x.e) with id_subst = [x |-> e']
1387         -- Here we must simply zap the substitution for x
1388
1389     new_var = uniqAway in_scope subst_old_var
1390         -- The uniqAway part makes sure the new variable is not already in scope
1391
1392     subst_old_var -- subst_old_var is old_var with the substitution applied to its kind
1393                   -- It's only worth doing the substitution for coercions,
1394                   -- becuase only they can have free type variables
1395         | is_co_var = setTyVarKind old_var (substTy subst (tyVarKind old_var))
1396         | otherwise = old_var
1397 \end{code}
1398
1399 ----------------------------------------------------
1400 -- Kind Stuff
1401
1402 Kinds
1403 ~~~~~
1404 There's a little subtyping at the kind level:
1405
1406                  ?
1407                 / \
1408                /   \
1409               ??   (#)
1410              /  \
1411             *   #
1412
1413 where   *    [LiftedTypeKind]   means boxed type
1414         #    [UnliftedTypeKind] means unboxed type
1415         (#)  [UbxTupleKind]     means unboxed tuple
1416         ??   [ArgTypeKind]      is the lub of *,#
1417         ?    [OpenTypeKind]     means any type at all
1418
1419 In particular:
1420
1421         error :: forall a:?. String -> a
1422         (->)  :: ?? -> ? -> *
1423         (\(x::t) -> ...)        Here t::?? (i.e. not unboxed tuple)
1424
1425 \begin{code}
1426 type KindVar = TyVar  -- invariant: KindVar will always be a
1427                       -- TcTyVar with details MetaTv TauTv ...
1428 -- kind var constructors and functions are in TcType
1429
1430 type SimpleKind = Kind
1431 \end{code}
1432
1433 Kind inference
1434 ~~~~~~~~~~~~~~
1435 During kind inference, a kind variable unifies only with
1436 a "simple kind", sk
1437         sk ::= * | sk1 -> sk2
1438 For example
1439         data T a = MkT a (T Int#)
1440 fails.  We give T the kind (k -> *), and the kind variable k won't unify
1441 with # (the kind of Int#).
1442
1443 Type inference
1444 ~~~~~~~~~~~~~~
1445 When creating a fresh internal type variable, we give it a kind to express
1446 constraints on it.  E.g. in (\x->e) we make up a fresh type variable for x,
1447 with kind ??.
1448
1449 During unification we only bind an internal type variable to a type
1450 whose kind is lower in the sub-kind hierarchy than the kind of the tyvar.
1451
1452 When unifying two internal type variables, we collect their kind constraints by
1453 finding the GLB of the two.  Since the partial order is a tree, they only
1454 have a glb if one is a sub-kind of the other.  In that case, we bind the
1455 less-informative one to the more informative one.  Neat, eh?
1456
1457
1458 \begin{code}
1459
1460 \end{code}
1461
1462 %************************************************************************
1463 %*                                                                      *
1464         Functions over Kinds
1465 %*                                                                      *
1466 %************************************************************************
1467
1468 \begin{code}
1469 kindFunResult :: Kind -> Kind
1470 kindFunResult k = funResultTy k
1471
1472 splitKindFunTys :: Kind -> ([Kind],Kind)
1473 splitKindFunTys k = splitFunTys k
1474
1475 splitKindFunTysN :: Int -> Kind -> ([Kind],Kind)
1476 splitKindFunTysN k = splitFunTysN k
1477
1478 isUbxTupleKind, isOpenTypeKind, isArgTypeKind, isUnliftedTypeKind :: Kind -> Bool
1479
1480 isOpenTypeKindCon tc    = tyConUnique tc == openTypeKindTyConKey
1481
1482 isOpenTypeKind (TyConApp tc _) = isOpenTypeKindCon tc
1483 isOpenTypeKind other           = False
1484
1485 isUbxTupleKindCon tc = tyConUnique tc == ubxTupleKindTyConKey
1486
1487 isUbxTupleKind (TyConApp tc _) = isUbxTupleKindCon tc
1488 isUbxTupleKind other           = False
1489
1490 isArgTypeKindCon tc = tyConUnique tc == argTypeKindTyConKey
1491
1492 isArgTypeKind (TyConApp tc _) = isArgTypeKindCon tc
1493 isArgTypeKind other = False
1494
1495 isUnliftedTypeKindCon tc = tyConUnique tc == unliftedTypeKindTyConKey
1496
1497 isUnliftedTypeKind (TyConApp tc _) = isUnliftedTypeKindCon tc
1498 isUnliftedTypeKind other           = False
1499
1500 isSubOpenTypeKind :: Kind -> Bool
1501 -- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
1502 isSubOpenTypeKind (FunTy k1 k2)    = ASSERT2 ( isKind k1, text "isSubOpenTypeKind" <+> ppr k1 <+> text "::" <+> ppr (typeKind k1) )
1503                                      ASSERT2 ( isKind k2, text "isSubOpenTypeKind" <+> ppr k2 <+> text "::" <+> ppr (typeKind k2) )
1504                                      False
1505 isSubOpenTypeKind (TyConApp kc []) = ASSERT( isKind (TyConApp kc []) ) True
1506 isSubOpenTypeKind other            = ASSERT( isKind other ) False
1507          -- This is a conservative answer
1508          -- It matters in the call to isSubKind in
1509          -- checkExpectedKind.
1510
1511 isSubArgTypeKindCon kc
1512   | isUnliftedTypeKindCon kc = True
1513   | isLiftedTypeKindCon kc   = True
1514   | isArgTypeKindCon kc      = True
1515   | otherwise                = False
1516
1517 isSubArgTypeKind :: Kind -> Bool
1518 -- True of any sub-kind of ArgTypeKind
1519 isSubArgTypeKind (TyConApp kc []) = isSubArgTypeKindCon kc
1520 isSubArgTypeKind other            = False
1521
1522 isSuperKind :: Type -> Bool
1523 isSuperKind (TyConApp (skc) []) = isSuperKindTyCon skc
1524 isSuperKind other = False
1525
1526 isKind :: Kind -> Bool
1527 isKind k = isSuperKind (typeKind k)
1528
1529 isSubKind :: Kind -> Kind -> Bool
1530 -- (k1 `isSubKind` k2) checks that k1 <: k2
1531 isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2
1532 isSubKind (FunTy a1 r1) (FunTy a2 r2)         = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
1533 isSubKind (PredTy (EqPred ty1 ty2)) (PredTy (EqPred ty1' ty2'))
1534   = ty1 `tcEqType` ty1' && ty2 `tcEqType` ty2'
1535 isSubKind k1            k2                    = False
1536
1537 eqKind :: Kind -> Kind -> Bool
1538 eqKind = tcEqType
1539
1540 isSubKindCon :: TyCon -> TyCon -> Bool
1541 -- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
1542 isSubKindCon kc1 kc2
1543   | isLiftedTypeKindCon kc1   && isLiftedTypeKindCon kc2   = True
1544   | isUnliftedTypeKindCon kc1 && isUnliftedTypeKindCon kc2 = True
1545   | isUbxTupleKindCon kc1     && isUbxTupleKindCon kc2     = True
1546   | isOpenTypeKindCon kc2                                  = True
1547                            -- we already know kc1 is not a fun, its a TyCon
1548   | isArgTypeKindCon kc2      && isSubArgTypeKindCon kc1   = True
1549   | otherwise                                              = False
1550
1551 defaultKind :: Kind -> Kind
1552 -- Used when generalising: default kind '?' and '??' to '*'
1553 --
1554 -- When we generalise, we make generic type variables whose kind is
1555 -- simple (* or *->* etc).  So generic type variables (other than
1556 -- built-in constants like 'error') always have simple kinds.  This is important;
1557 -- consider
1558 --      f x = True
1559 -- We want f to get type
1560 --      f :: forall (a::*). a -> Bool
1561 -- Not
1562 --      f :: forall (a::??). a -> Bool
1563 -- because that would allow a call like (f 3#) as well as (f True),
1564 --and the calling conventions differ.  This defaulting is done in TcMType.zonkTcTyVarBndr.
1565 defaultKind k
1566   | isSubOpenTypeKind k = liftedTypeKind
1567   | isSubArgTypeKind k  = liftedTypeKind
1568   | otherwise        = k
1569
1570 isEqPred :: PredType -> Bool
1571 isEqPred (EqPred _ _) = True
1572 isEqPred other        = False
1573 \end{code}