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, pprTyThing, 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
1008   | tcEqType t1 t2              = True
1009 tcPartOfType t1              t2
1010   | Just t2' <- tcView t2       = tcPartOfType t1 t2'
1011 tcPartOfType _  (TyVarTy _)     = False
1012 tcPartOfType t1 (ForAllTy _ t2) = tcPartOfType t1 t2
1013 tcPartOfType t1 (AppTy s2 t2)   = tcPartOfType t1 s2 || tcPartOfType t1 t2
1014 tcPartOfType t1 (FunTy s2 t2)   = tcPartOfType t1 s2 || tcPartOfType t1 t2
1015 tcPartOfType t1 (PredTy p2)     = tcPartOfPred t1 p2
1016 tcPartOfType t1 (TyConApp _ ts) = any (tcPartOfType t1) ts
1017 tcPartOfType t1 (NoteTy _ t2)   = tcPartOfType t1 t2
1018
1019 tcPartOfPred :: Type -> PredType -> Bool
1020 tcPartOfPred t1 (IParam _ t2)  = tcPartOfType t1 t2
1021 tcPartOfPred t1 (ClassP _ ts)  = any (tcPartOfType t1) ts
1022 tcPartOfPred t1 (EqPred s2 t2) = tcPartOfType t1 s2 || tcPartOfType t1 t2
1023 \end{code}
1024
1025 Now here comes the real worker
1026
1027 \begin{code}
1028 cmpType :: Type -> Type -> Ordering
1029 cmpType t1 t2 = cmpTypeX rn_env t1 t2
1030   where
1031     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
1032
1033 cmpTypes :: [Type] -> [Type] -> Ordering
1034 cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
1035   where
1036     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
1037
1038 cmpPred :: PredType -> PredType -> Ordering
1039 cmpPred p1 p2 = cmpPredX rn_env p1 p2
1040   where
1041     rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
1042
1043 cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering  -- Main workhorse
1044 cmpTypeX env t1 t2 | Just t1' <- tcView t1 = cmpTypeX env t1' t2
1045                    | Just t2' <- tcView t2 = cmpTypeX env t1 t2'
1046
1047 cmpTypeX env (TyVarTy tv1)       (TyVarTy tv2)       = rnOccL env tv1 `compare` rnOccR env tv2
1048 cmpTypeX env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
1049 cmpTypeX env (AppTy s1 t1)       (AppTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
1050 cmpTypeX env (FunTy s1 t1)       (FunTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
1051 cmpTypeX env (PredTy p1)         (PredTy p2)         = cmpPredX env p1 p2
1052 cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
1053 cmpTypeX env t1                 (NoteTy _ t2)        = cmpTypeX env t1 t2
1054
1055     -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy
1056 cmpTypeX env (AppTy _ _) (TyVarTy _) = GT
1057
1058 cmpTypeX env (FunTy _ _) (TyVarTy _) = GT
1059 cmpTypeX env (FunTy _ _) (AppTy _ _) = GT
1060
1061 cmpTypeX env (TyConApp _ _) (TyVarTy _) = GT
1062 cmpTypeX env (TyConApp _ _) (AppTy _ _) = GT
1063 cmpTypeX env (TyConApp _ _) (FunTy _ _) = GT
1064
1065 cmpTypeX env (ForAllTy _ _) (TyVarTy _)    = GT
1066 cmpTypeX env (ForAllTy _ _) (AppTy _ _)    = GT
1067 cmpTypeX env (ForAllTy _ _) (FunTy _ _)    = GT
1068 cmpTypeX env (ForAllTy _ _) (TyConApp _ _) = GT
1069
1070 cmpTypeX env (PredTy _)   t2            = GT
1071
1072 cmpTypeX env _ _ = LT
1073
1074 -------------
1075 cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
1076 cmpTypesX env []        []        = EQ
1077 cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 `thenCmp` cmpTypesX env tys1 tys2
1078 cmpTypesX env []        tys       = LT
1079 cmpTypesX env ty        []        = GT
1080
1081 -------------
1082 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
1083 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
1084         -- Compare names only for implicit parameters
1085         -- This comparison is used exclusively (I believe)
1086         -- for the Avails finite map built in TcSimplify
1087         -- If the types differ we keep them distinct so that we see
1088         -- a distinct pair to run improvement on
1089 cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
1090 cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
1091
1092 -- Constructor order: IParam < ClassP < EqPred
1093 cmpPredX env (IParam {})     _              = LT
1094 cmpPredX env (ClassP {})    (IParam {})     = GT
1095 cmpPredX env (ClassP {})    (EqPred {})     = LT
1096 cmpPredX env (EqPred {})    _               = GT
1097 \end{code}
1098
1099 PredTypes are used as a FM key in TcSimplify,
1100 so we take the easy path and make them an instance of Ord
1101
1102 \begin{code}
1103 instance Eq  PredType where { (==)    = tcEqPred }
1104 instance Ord PredType where { compare = tcCmpPred }
1105 \end{code}
1106
1107
1108 %************************************************************************
1109 %*                                                                      *
1110                 Type substitutions
1111 %*                                                                      *
1112 %************************************************************************
1113
1114 \begin{code}
1115 data TvSubst
1116   = TvSubst InScopeSet  -- The in-scope type variables
1117             TvSubstEnv  -- The substitution itself
1118         -- See Note [Apply Once]
1119         -- and Note [Extending the TvSubstEnv]
1120
1121 {- ----------------------------------------------------------
1122
1123 Note [Apply Once]
1124 ~~~~~~~~~~~~~~~~~
1125 We use TvSubsts to instantiate things, and we might instantiate
1126         forall a b. ty
1127 \with the types
1128         [a, b], or [b, a].
1129 So the substition might go [a->b, b->a].  A similar situation arises in Core
1130 when we find a beta redex like
1131         (/\ a /\ b -> e) b a
1132 Then we also end up with a substition that permutes type variables. Other
1133 variations happen to; for example [a -> (a, b)].
1134
1135         ***************************************************
1136         *** So a TvSubst must be applied precisely once ***
1137         ***************************************************
1138
1139 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
1140 we use during unifications, it must not be repeatedly applied.
1141
1142 Note [Extending the TvSubst]
1143 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1144 The following invariant should hold of a TvSubst
1145
1146         The in-scope set is needed *only* to
1147         guide the generation of fresh uniques
1148
1149         In particular, the *kind* of the type variables in
1150         the in-scope set is not relevant
1151
1152 This invariant allows a short-cut when the TvSubstEnv is empty:
1153 if the TvSubstEnv is empty --- i.e. (isEmptyTvSubt subst) holds ---
1154 then (substTy subst ty) does nothing.
1155
1156 For example, consider:
1157         (/\a. /\b:(a~Int). ...b..) Int
1158 We substitute Int for 'a'.  The Unique of 'b' does not change, but
1159 nevertheless we add 'b' to the TvSubstEnv, because b's type does change
1160
1161 This invariant has several crucial consequences:
1162
1163 * In substTyVarBndr, we need extend the TvSubstEnv
1164         - if the unique has changed
1165         - or if the kind has changed
1166
1167 * In substTyVar, we do not need to consult the in-scope set;
1168   the TvSubstEnv is enough
1169
1170 * In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty
1171
1172
1173 -------------------------------------------------------------- -}
1174
1175
1176 type TvSubstEnv = TyVarEnv Type
1177         -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
1178         -- invariant discussed in Note [Apply Once]), and also independently
1179         -- in the middle of matching, and unification (see Types.Unify)
1180         -- So you have to look at the context to know if it's idempotent or
1181         -- apply-once or whatever
1182 emptyTvSubstEnv :: TvSubstEnv
1183 emptyTvSubstEnv = emptyVarEnv
1184
1185 composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
1186 -- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
1187 -- It assumes that both are idempotent
1188 -- Typically, env1 is the refinement to a base substitution env2
1189 composeTvSubst in_scope env1 env2
1190   = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
1191         -- First apply env1 to the range of env2
1192         -- Then combine the two, making sure that env1 loses if
1193         -- both bind the same variable; that's why env1 is the
1194         --  *left* argument to plusVarEnv, because the right arg wins
1195   where
1196     subst1 = TvSubst in_scope env1
1197
1198 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
1199
1200 isEmptyTvSubst :: TvSubst -> Bool
1201          -- See Note [Extending the TvSubstEnv]
1202 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
1203
1204 mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
1205 mkTvSubst = TvSubst
1206
1207 getTvSubstEnv :: TvSubst -> TvSubstEnv
1208 getTvSubstEnv (TvSubst _ env) = env
1209
1210 getTvInScope :: TvSubst -> InScopeSet
1211 getTvInScope (TvSubst in_scope _) = in_scope
1212
1213 isInScope :: Var -> TvSubst -> Bool
1214 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
1215
1216 notElemTvSubst :: TyVar -> TvSubst -> Bool
1217 notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
1218
1219 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
1220 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
1221
1222 extendTvInScope :: TvSubst -> [Var] -> TvSubst
1223 extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
1224
1225 extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
1226 extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
1227
1228 extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
1229 extendTvSubstList (TvSubst in_scope env) tvs tys
1230   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
1231
1232 -- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
1233 -- the types given; but it's just a thunk so with a bit of luck
1234 -- it'll never be evaluated
1235
1236 mkOpenTvSubst :: TvSubstEnv -> TvSubst
1237 mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
1238
1239 zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
1240 zipOpenTvSubst tyvars tys
1241 #ifdef DEBUG
1242   | length tyvars /= length tys
1243   = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1244   | otherwise
1245 #endif
1246   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
1247
1248 -- mkTopTvSubst is called when doing top-level substitutions.
1249 -- Here we expect that the free vars of the range of the
1250 -- substitution will be empty.
1251 mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
1252 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
1253
1254 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
1255 zipTopTvSubst tyvars tys
1256 #ifdef DEBUG
1257   | length tyvars /= length tys
1258   = pprTrace "zipTopTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
1259   | otherwise
1260 #endif
1261   = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
1262
1263 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
1264 zipTyEnv tyvars tys
1265 #ifdef DEBUG
1266   | length tyvars /= length tys
1267   = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
1268   | otherwise
1269 #endif
1270   = zip_ty_env tyvars tys emptyVarEnv
1271
1272 -- Later substitutions in the list over-ride earlier ones,
1273 -- but there should be no loops
1274 zip_ty_env []       []       env = env
1275 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
1276         -- There used to be a special case for when
1277         --      ty == TyVarTy tv
1278         -- (a not-uncommon case) in which case the substitution was dropped.
1279         -- But the type-tidier changes the print-name of a type variable without
1280         -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had
1281         -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.
1282         -- And it happened that t was the type variable of the class.  Post-tiding,
1283         -- it got turned into {Foo t2}.  The ext-core printer expanded this using
1284         -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
1285         -- and so generated a rep type mentioning t not t2.
1286         --
1287         -- Simplest fix is to nuke the "optimisation"
1288 zip_ty_env tvs      tys      env   = pprTrace "Var/Type length mismatch: " (ppr tvs $$ ppr tys) env
1289 -- zip_ty_env _ _ env = env
1290
1291 instance Outputable TvSubst where
1292   ppr (TvSubst ins env)
1293     = brackets $ sep[ ptext SLIT("TvSubst"),
1294                       nest 2 (ptext SLIT("In scope:") <+> ppr ins),
1295                       nest 2 (ptext SLIT("Env:") <+> ppr env) ]
1296 \end{code}
1297
1298 %************************************************************************
1299 %*                                                                      *
1300                 Performing type substitutions
1301 %*                                                                      *
1302 %************************************************************************
1303
1304 \begin{code}
1305 substTyWith :: [TyVar] -> [Type] -> Type -> Type
1306 substTyWith tvs tys = ASSERT( length tvs == length tys )
1307                       substTy (zipOpenTvSubst tvs tys)
1308
1309 substTy :: TvSubst -> Type  -> Type
1310 substTy subst ty | isEmptyTvSubst subst = ty
1311                  | otherwise            = subst_ty subst ty
1312
1313 substTys :: TvSubst -> [Type] -> [Type]
1314 substTys subst tys | isEmptyTvSubst subst = tys
1315                    | otherwise            = map (subst_ty subst) tys
1316
1317 substTheta :: TvSubst -> ThetaType -> ThetaType
1318 substTheta subst theta
1319   | isEmptyTvSubst subst = theta
1320   | otherwise            = map (substPred subst) theta
1321
1322 substPred :: TvSubst -> PredType -> PredType
1323 substPred subst (IParam n ty)     = IParam n (subst_ty subst ty)
1324 substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
1325 substPred subst (EqPred ty1 ty2)  = EqPred (subst_ty subst ty1) (subst_ty subst ty2)
1326
1327 deShadowTy :: TyVarSet -> Type -> Type  -- Remove any nested binders mentioning tvs
1328 deShadowTy tvs ty
1329   = subst_ty (mkTvSubst in_scope emptyTvSubstEnv) ty
1330   where
1331     in_scope = mkInScopeSet tvs
1332
1333 subst_ty :: TvSubst -> Type -> Type
1334 -- subst_ty is the main workhorse for type substitution
1335 --
1336 -- Note that the in_scope set is poked only if we hit a forall
1337 -- so it may often never be fully computed
1338 subst_ty subst ty
1339    = go ty
1340   where
1341     go (TyVarTy tv)                = substTyVar subst tv
1342     go (TyConApp tc tys)           = let args = map go tys
1343                                      in  args `seqList` TyConApp tc args
1344
1345     go (PredTy p)                  = PredTy $! (substPred subst p)
1346
1347     go (NoteTy (FTVNote _) ty2)    = go ty2             -- Discard the free tyvar note
1348
1349     go (FunTy arg res)             = (FunTy $! (go arg)) $! (go res)
1350     go (AppTy fun arg)             = mkAppTy (go fun) $! (go arg)
1351                 -- The mkAppTy smart constructor is important
1352                 -- we might be replacing (a Int), represented with App
1353                 -- by [Int], represented with TyConApp
1354     go (ForAllTy tv ty)            = case substTyVarBndr subst tv of
1355                                         (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
1356
1357 substTyVar :: TvSubst -> TyVar  -> Type
1358 substTyVar subst@(TvSubst in_scope env) tv
1359   = case lookupTyVar subst tv of {
1360         Nothing -> TyVarTy tv;
1361         Just ty -> ty   -- See Note [Apply Once]
1362     }
1363
1364 substTyVars :: TvSubst -> [TyVar] -> [Type]
1365 substTyVars subst tvs = map (substTyVar subst) tvs
1366
1367 lookupTyVar :: TvSubst -> TyVar  -> Maybe Type
1368         -- See Note [Extending the TvSubst]
1369 lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv
1370
1371 substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)
1372 substTyVarBndr subst@(TvSubst in_scope env) old_var
1373   = (TvSubst (in_scope `extendInScopeSet` new_var) new_env, new_var)
1374   where
1375     is_co_var = isCoVar old_var
1376
1377     new_env | no_change = delVarEnv env old_var
1378             | otherwise = extendVarEnv env old_var (TyVarTy new_var)
1379
1380     no_change = new_var == old_var && not is_co_var
1381         -- no_change means that the new_var is identical in
1382         -- all respects to the old_var (same unique, same kind)
1383         -- See Note [Extending the TvSubst]
1384         --
1385         -- In that case we don't need to extend the substitution
1386         -- to map old to new.  But instead we must zap any
1387         -- current substitution for the variable. For example:
1388         --      (\x.e) with id_subst = [x |-> e']
1389         -- Here we must simply zap the substitution for x
1390
1391     new_var = uniqAway in_scope subst_old_var
1392         -- The uniqAway part makes sure the new variable is not already in scope
1393
1394     subst_old_var -- subst_old_var is old_var with the substitution applied to its kind
1395                   -- It's only worth doing the substitution for coercions,
1396                   -- becuase only they can have free type variables
1397         | is_co_var = setTyVarKind old_var (substTy subst (tyVarKind old_var))
1398         | otherwise = old_var
1399 \end{code}
1400
1401 ----------------------------------------------------
1402 -- Kind Stuff
1403
1404 Kinds
1405 ~~~~~
1406 There's a little subtyping at the kind level:
1407
1408                  ?
1409                 / \
1410                /   \
1411               ??   (#)
1412              /  \
1413             *   #
1414
1415 where   *    [LiftedTypeKind]   means boxed type
1416         #    [UnliftedTypeKind] means unboxed type
1417         (#)  [UbxTupleKind]     means unboxed tuple
1418         ??   [ArgTypeKind]      is the lub of *,#
1419         ?    [OpenTypeKind]     means any type at all
1420
1421 In particular:
1422
1423         error :: forall a:?. String -> a
1424         (->)  :: ?? -> ? -> *
1425         (\(x::t) -> ...)        Here t::?? (i.e. not unboxed tuple)
1426
1427 \begin{code}
1428 type KindVar = TyVar  -- invariant: KindVar will always be a
1429                       -- TcTyVar with details MetaTv TauTv ...
1430 -- kind var constructors and functions are in TcType
1431
1432 type SimpleKind = Kind
1433 \end{code}
1434
1435 Kind inference
1436 ~~~~~~~~~~~~~~
1437 During kind inference, a kind variable unifies only with
1438 a "simple kind", sk
1439         sk ::= * | sk1 -> sk2
1440 For example
1441         data T a = MkT a (T Int#)
1442 fails.  We give T the kind (k -> *), and the kind variable k won't unify
1443 with # (the kind of Int#).
1444
1445 Type inference
1446 ~~~~~~~~~~~~~~
1447 When creating a fresh internal type variable, we give it a kind to express
1448 constraints on it.  E.g. in (\x->e) we make up a fresh type variable for x,
1449 with kind ??.
1450
1451 During unification we only bind an internal type variable to a type
1452 whose kind is lower in the sub-kind hierarchy than the kind of the tyvar.
1453
1454 When unifying two internal type variables, we collect their kind constraints by
1455 finding the GLB of the two.  Since the partial order is a tree, they only
1456 have a glb if one is a sub-kind of the other.  In that case, we bind the
1457 less-informative one to the more informative one.  Neat, eh?
1458
1459
1460 \begin{code}
1461
1462 \end{code}
1463
1464 %************************************************************************
1465 %*                                                                      *
1466         Functions over Kinds
1467 %*                                                                      *
1468 %************************************************************************
1469
1470 \begin{code}
1471 kindFunResult :: Kind -> Kind
1472 kindFunResult k = funResultTy k
1473
1474 splitKindFunTys :: Kind -> ([Kind],Kind)
1475 splitKindFunTys k = splitFunTys k
1476
1477 splitKindFunTysN :: Int -> Kind -> ([Kind],Kind)
1478 splitKindFunTysN k = splitFunTysN k
1479
1480 isUbxTupleKind, isOpenTypeKind, isArgTypeKind, isUnliftedTypeKind :: Kind -> Bool
1481
1482 isOpenTypeKindCon tc    = tyConUnique tc == openTypeKindTyConKey
1483
1484 isOpenTypeKind (TyConApp tc _) = isOpenTypeKindCon tc
1485 isOpenTypeKind other           = False
1486
1487 isUbxTupleKindCon tc = tyConUnique tc == ubxTupleKindTyConKey
1488
1489 isUbxTupleKind (TyConApp tc _) = isUbxTupleKindCon tc
1490 isUbxTupleKind other           = False
1491
1492 isArgTypeKindCon tc = tyConUnique tc == argTypeKindTyConKey
1493
1494 isArgTypeKind (TyConApp tc _) = isArgTypeKindCon tc
1495 isArgTypeKind other = False
1496
1497 isUnliftedTypeKindCon tc = tyConUnique tc == unliftedTypeKindTyConKey
1498
1499 isUnliftedTypeKind (TyConApp tc _) = isUnliftedTypeKindCon tc
1500 isUnliftedTypeKind other           = False
1501
1502 isSubOpenTypeKind :: Kind -> Bool
1503 -- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
1504 isSubOpenTypeKind (FunTy k1 k2)    = ASSERT2 ( isKind k1, text "isSubOpenTypeKind" <+> ppr k1 <+> text "::" <+> ppr (typeKind k1) )
1505                                      ASSERT2 ( isKind k2, text "isSubOpenTypeKind" <+> ppr k2 <+> text "::" <+> ppr (typeKind k2) )
1506                                      False
1507 isSubOpenTypeKind (TyConApp kc []) = ASSERT( isKind (TyConApp kc []) ) True
1508 isSubOpenTypeKind other            = ASSERT( isKind other ) False
1509          -- This is a conservative answer
1510          -- It matters in the call to isSubKind in
1511          -- checkExpectedKind.
1512
1513 isSubArgTypeKindCon kc
1514   | isUnliftedTypeKindCon kc = True
1515   | isLiftedTypeKindCon kc   = True
1516   | isArgTypeKindCon kc      = True
1517   | otherwise                = False
1518
1519 isSubArgTypeKind :: Kind -> Bool
1520 -- True of any sub-kind of ArgTypeKind
1521 isSubArgTypeKind (TyConApp kc []) = isSubArgTypeKindCon kc
1522 isSubArgTypeKind other            = False
1523
1524 isSuperKind :: Type -> Bool
1525 isSuperKind (TyConApp (skc) []) = isSuperKindTyCon skc
1526 isSuperKind other = False
1527
1528 isKind :: Kind -> Bool
1529 isKind k = isSuperKind (typeKind k)
1530
1531 isSubKind :: Kind -> Kind -> Bool
1532 -- (k1 `isSubKind` k2) checks that k1 <: k2
1533 isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2
1534 isSubKind (FunTy a1 r1) (FunTy a2 r2)         = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
1535 isSubKind (PredTy (EqPred ty1 ty2)) (PredTy (EqPred ty1' ty2'))
1536   = ty1 `tcEqType` ty1' && ty2 `tcEqType` ty2'
1537 isSubKind k1            k2                    = False
1538
1539 eqKind :: Kind -> Kind -> Bool
1540 eqKind = tcEqType
1541
1542 isSubKindCon :: TyCon -> TyCon -> Bool
1543 -- (kc1 `isSubKindCon` kc2) checks that kc1 <: kc2
1544 isSubKindCon kc1 kc2
1545   | isLiftedTypeKindCon kc1   && isLiftedTypeKindCon kc2   = True
1546   | isUnliftedTypeKindCon kc1 && isUnliftedTypeKindCon kc2 = True
1547   | isUbxTupleKindCon kc1     && isUbxTupleKindCon kc2     = True
1548   | isOpenTypeKindCon kc2                                  = True
1549                            -- we already know kc1 is not a fun, its a TyCon
1550   | isArgTypeKindCon kc2      && isSubArgTypeKindCon kc1   = True
1551   | otherwise                                              = False
1552
1553 defaultKind :: Kind -> Kind
1554 -- Used when generalising: default kind '?' and '??' to '*'
1555 --
1556 -- When we generalise, we make generic type variables whose kind is
1557 -- simple (* or *->* etc).  So generic type variables (other than
1558 -- built-in constants like 'error') always have simple kinds.  This is important;
1559 -- consider
1560 --      f x = True
1561 -- We want f to get type
1562 --      f :: forall (a::*). a -> Bool
1563 -- Not
1564 --      f :: forall (a::??). a -> Bool
1565 -- because that would allow a call like (f 3#) as well as (f True),
1566 --and the calling conventions differ.  This defaulting is done in TcMType.zonkTcTyVarBndr.
1567 defaultKind k
1568   | isSubOpenTypeKind k = liftedTypeKind
1569   | isSubArgTypeKind k  = liftedTypeKind
1570   | otherwise        = k
1571
1572 isEqPred :: PredType -> Bool
1573 isEqPred (EqPred _ _) = True
1574 isEqPred other        = False
1575 \end{code}