ghc/compiler/types/Type.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
   3 %
   4 \section[Type]{Type - public interface}
   5
   6 \begin{code}
   7 module Type (
   8         -- re-exports from TypeRep
   9         TyThing(..), Type, PredType(..), ThetaType,
  10         funTyCon,
  11
  12         -- Re-exports from Kind
  13         module Kind,
  14
  15         -- Re-exports from TyCon
  16         PrimRep(..),
  17
  18         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
  19
  20         mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
  21
  22         mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe,
  23         splitFunTys, splitFunTysN,
  24         funResultTy, funArgTy, zipFunTys, isFunTy,
  25
  26         mkGenTyConApp, mkTyConApp, mkTyConTy,
  27         tyConAppTyCon, tyConAppArgs,
  28         splitTyConApp_maybe, splitTyConApp,
  29
  30         mkSynTy,
  31
  32         repType, typePrimRep, coreView,
  33
  34         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
  35         applyTy, applyTys, isForAllTy, dropForAlls,
  36
  37         -- Source types
  38         predTypeRep, mkPredTy, mkPredTys,
  39
  40         -- Newtypes
  41         splitRecNewType_maybe,
  42
  43         -- Lifting and boxity
  44         isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
  45         isStrictType, isStrictPred,
  46
  47         -- Free variables
  48         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
  49         typeKind, addFreeTyVars,
  50
  51         -- Tidying up for printing
  52         tidyType,      tidyTypes,
  53         tidyOpenType,  tidyOpenTypes,
  54         tidyTyVarBndr, tidyFreeTyVars,
  55         tidyOpenTyVar, tidyOpenTyVars,
  56         tidyTopType,   tidyPred,
  57
  58         -- Comparison
  59         eqType,
  60
  61         -- Seq
  62         seqType, seqTypes,
  63
  64         -- Type substitutions
  65         TvSubst(..),    -- Representation visible to a few friends
  66         TvSubstEnv, emptyTvSubst,
  67         mkTvSubst, zipTvSubst, zipTopTvSubst, mkTopTvSubst,
  68         getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
  69         extendTvSubst, extendTvSubstList, isInScope,
  70
  71         -- Performing substitution on types
  72         substTy, substTys, substTyWith, substTheta, substTyVar,
  73         deShadowTy,
  74
  75         -- Pretty-printing
  76         pprType, pprParendType, pprTyThingCategory,
  77         pprPred, pprTheta, pprThetaArrow, pprClassPred
  78     ) where
  79
  80 #include "HsVersions.h"
  81
  82 -- We import the representation and primitive functions from TypeRep.
  83 -- Many things are reexported, but not the representation!
  84
  85 import TypeRep
  86
  87 -- friends:
  88 import Kind
  89 import Var      ( Var, TyVar, tyVarKind, tyVarName, setTyVarName )
  90 import VarEnv
  91 import VarSet
  92
  93 import Name     ( NamedThing(..), mkInternalName, tidyOccName )
  94 import Class    ( Class, classTyCon )
  95 import TyCon    ( TyCon, isRecursiveTyCon, isPrimTyCon,
  96                   isUnboxedTupleTyCon, isUnLiftedTyCon,
  97                   isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
  98                   isAlgTyCon, isSynTyCon, tyConArity, newTyConRhs_maybe,
  99                   tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
 100                 )
 101
 102 -- others
 103 import CmdLineOpts      ( opt_DictsStrict )
 104 import SrcLoc           ( noSrcLoc )
 105 import Unique           ( Uniquable(..) )
 106 import Util             ( mapAccumL, seqList, lengthIs, snocView )
 107 import Outputable
 108 import UniqSet          ( sizeUniqSet )         -- Should come via VarSet
 109 import Maybe            ( isJust )
 110 \end{code}
 111
 112
 113 %************************************************************************
 114 %*                                                                      *
 115                 Type representation
 116 %*                                                                      *
 117 %************************************************************************
 118
 119 In Core, we "look through" non-recursive newtypes and PredTypes.
 120
 121 \begin{code}
 122 {-# INLINE coreView #-}
 123 coreView :: Type -> Maybe Type
 124 -- Srips off the *top layer only* of a type to give
 125 -- its underlying representation type.
 126 -- Returns Nothing if there is nothing to look through.
 127 --
 128 -- By being non-recursive and inlined, this case analysis gets efficiently
 129 -- joined onto the case analysis that the caller is already doing
 130 coreView (NoteTy _ ty)     = Just ty
 131 coreView (PredTy p)        = Just (predTypeRep p)
 132 coreView (TyConApp tc tys) = expandNewTcApp tc tys
 133 coreView ty                = Nothing
 134
 135 expandNewTcApp :: TyCon -> [Type] -> Maybe Type
 136 -- A local helper function (not exported)
 137 -- Expands *the outermoset level of* a newtype application to
 138 --      *either* a vanilla TyConApp (recursive newtype, or non-saturated)
 139 --      *or*     the newtype representation (otherwise), meaning the
 140 --                      type written in the RHS of the newtype decl,
 141 --                      which may itself be a newtype
 142 --
 143 -- Example: newtype R = MkR S
 144 --          newtype S = MkS T
 145 --          newtype T = MkT (T -> T)
 146 --   expandNewTcApp on R gives Just S
 147 --                  on S gives Just T
 148 --                  on T gives Nothing   (no expansion)
 149
 150 expandNewTcApp tc tys = case newTyConRhs_maybe tc tys of
 151                           Nothing          -> Nothing
 152                           Just (tenv, rhs) -> Just (substTy (mkTopTvSubst tenv) rhs)
 153 \end{code}
 154
 155
 156 %************************************************************************
 157 %*                                                                      *
 158 \subsection{Constructor-specific functions}
 159 %*                                                                      *
 160 %************************************************************************
 161
 162
 163 ---------------------------------------------------------------------
 164                                 TyVarTy
 165                                 ~~~~~~~
 166 \begin{code}
 167 mkTyVarTy  :: TyVar   -> Type
 168 mkTyVarTy  = TyVarTy
 169
 170 mkTyVarTys :: [TyVar] -> [Type]
 171 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 172
 173 getTyVar :: String -> Type -> TyVar
 174 getTyVar msg ty = case getTyVar_maybe ty of
 175                     Just tv -> tv
 176                     Nothing -> panic ("getTyVar: " ++ msg)
 177
 178 isTyVarTy :: Type -> Bool
 179 isTyVarTy ty = isJust (getTyVar_maybe ty)
 180
 181 getTyVar_maybe :: Type -> Maybe TyVar
 182 getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
 183 getTyVar_maybe (TyVarTy tv)                 = Just tv
 184 getTyVar_maybe other                        = Nothing
 185 \end{code}
 186
 187
 188 ---------------------------------------------------------------------
 189                                 AppTy
 190                                 ~~~~~
 191 We need to be pretty careful with AppTy to make sure we obey the
 192 invariant that a TyConApp is always visibly so.  mkAppTy maintains the
 193 invariant: use it.
 194
 195 \begin{code}
 196 mkAppTy orig_ty1 orig_ty2
 197   = mk_app orig_ty1
 198   where
 199     mk_app (NoteTy _ ty1)    = mk_app ty1
 200     mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
 201     mk_app ty1               = AppTy orig_ty1 orig_ty2
 202         -- We call mkGenTyConApp because the TyConApp could be an
 203         -- under-saturated type synonym.  GHC allows that; e.g.
 204         --      type Foo k = k a -> k a
 205         --      type Id x = x
 206         --      foo :: Foo Id -> Foo Id
 207         --
 208         -- Here Id is partially applied in the type sig for Foo,
 209         -- but once the type synonyms are expanded all is well
 210
 211 mkAppTys :: Type -> [Type] -> Type
 212 mkAppTys orig_ty1 []        = orig_ty1
 213         -- This check for an empty list of type arguments
 214         -- avoids the needless loss of a type synonym constructor.
 215         -- For example: mkAppTys Rational []
 216         --   returns to (Ratio Integer), which has needlessly lost
 217         --   the Rational part.
 218 mkAppTys orig_ty1 orig_tys2
 219   = mk_app orig_ty1
 220   where
 221     mk_app (NoteTy _ ty1)    = mk_app ty1
 222     mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ orig_tys2)
 223                                 -- mkGenTyConApp: see notes with mkAppTy
 224     mk_app ty1               = foldl AppTy orig_ty1 orig_tys2
 225
 226 splitAppTy_maybe :: Type -> Maybe (Type, Type)
 227 splitAppTy_maybe ty | Just ty' <- coreView ty = splitAppTy_maybe ty'
 228 splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 229 splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 230 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
 231                                         Nothing         -> Nothing
 232                                         Just (tys',ty') -> Just (TyConApp tc tys', ty')
 233 splitAppTy_maybe other             = Nothing
 234
 235 splitAppTy :: Type -> (Type, Type)
 236 splitAppTy ty = case splitAppTy_maybe ty of
 237                         Just pr -> pr
 238                         Nothing -> panic "splitAppTy"
 239
 240 splitAppTys :: Type -> (Type, [Type])
 241 splitAppTys ty = split ty ty []
 242   where
 243     split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
 244     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
 245     split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
 246     split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
 247                                                (TyConApp funTyCon [], [ty1,ty2])
 248     split orig_ty ty                    args = (orig_ty, args)
 249 \end{code}
 250
 251
 252 ---------------------------------------------------------------------
 253                                 FunTy
 254                                 ~~~~~
 255
 256 \begin{code}
 257 mkFunTy :: Type -> Type -> Type
 258 mkFunTy arg res = FunTy arg res
 259
 260 mkFunTys :: [Type] -> Type -> Type
 261 mkFunTys tys ty = foldr FunTy ty tys
 262
 263 isFunTy :: Type -> Bool
 264 isFunTy ty = isJust (splitFunTy_maybe ty)
 265
 266 splitFunTy :: Type -> (Type, Type)
 267 splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
 268 splitFunTy (FunTy arg res)   = (arg, res)
 269 splitFunTy other             = pprPanic "splitFunTy" (ppr other)
 270
 271 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 272 splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
 273 splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
 274 splitFunTy_maybe other             = Nothing
 275
 276 splitFunTys :: Type -> ([Type], Type)
 277 splitFunTys ty = split [] ty ty
 278   where
 279     split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
 280     split args orig_ty (FunTy arg res)   = split (arg:args) res res
 281     split args orig_ty ty                = (reverse args, orig_ty)
 282
 283 splitFunTysN :: Int -> Type -> ([Type], Type)
 284 -- Split off exactly n arg tys
 285 splitFunTysN 0 ty = ([], ty)
 286 splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
 287                     case splitFunTysN (n-1) res of { (args, res) ->
 288                     (arg:args, res) }}
 289
 290 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
 291 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
 292   where
 293     split acc []     nty ty                = (reverse acc, nty)
 294     split acc xs     nty ty
 295           | Just ty' <- coreView ty        = split acc xs nty ty'
 296     split acc (x:xs) nty (FunTy arg res)   = split ((x,arg):acc) xs res res
 297     split acc (x:xs) nty ty                = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
 298
 299 funResultTy :: Type -> Type
 300 funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
 301 funResultTy (FunTy arg res)   = res
 302 funResultTy ty                = pprPanic "funResultTy" (ppr ty)
 303
 304 funArgTy :: Type -> Type
 305 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
 306 funArgTy (FunTy arg res)   = arg
 307 funArgTy ty                = pprPanic "funArgTy" (ppr ty)
 308 \end{code}
 309
 310
 311 ---------------------------------------------------------------------
 312                                 TyConApp
 313                                 ~~~~~~~~
 314 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
 315 as apppropriate.
 316
 317 \begin{code}
 318 mkGenTyConApp :: TyCon -> [Type] -> Type
 319 mkGenTyConApp tc tys
 320   | isSynTyCon tc = mkSynTy tc tys
 321   | otherwise     = mkTyConApp tc tys
 322
 323 mkTyConApp :: TyCon -> [Type] -> Type
 324 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
 325 mkTyConApp tycon tys
 326   | isFunTyCon tycon, [ty1,ty2] <- tys
 327   = FunTy ty1 ty2
 328
 329   | otherwise
 330   = ASSERT(not (isSynTyCon tycon))
 331     TyConApp tycon tys
 332
 333 mkTyConTy :: TyCon -> Type
 334 mkTyConTy tycon = mkTyConApp tycon []
 335
 336 -- splitTyConApp "looks through" synonyms, because they don't
 337 -- mean a distinct type, but all other type-constructor applications
 338 -- including functions are returned as Just ..
 339
 340 tyConAppTyCon :: Type -> TyCon
 341 tyConAppTyCon ty = fst (splitTyConApp ty)
 342
 343 tyConAppArgs :: Type -> [Type]
 344 tyConAppArgs ty = snd (splitTyConApp ty)
 345
 346 splitTyConApp :: Type -> (TyCon, [Type])
 347 splitTyConApp ty = case splitTyConApp_maybe ty of
 348                         Just stuff -> stuff
 349                         Nothing    -> pprPanic "splitTyConApp" (ppr ty)
 350
 351 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 352 splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
 353 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 354 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 355 splitTyConApp_maybe other             = Nothing
 356 \end{code}
 357
 358
 359 ---------------------------------------------------------------------
 360                                 SynTy
 361                                 ~~~~~
 362
 363 \begin{code}
 364 mkSynTy tycon tys
 365   | n_args == arity     -- Exactly saturated
 366   = mk_syn tys
 367   | n_args >  arity     -- Over-saturated
 368   = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
 369         -- Its important to use mkAppTys, rather than (foldl AppTy),
 370         -- because (mk_syn as) might well return a partially-applied
 371         -- type constructor; indeed, usually will!
 372   | otherwise           -- Un-saturated
 373   = TyConApp tycon tys
 374         -- For the un-saturated case we build TyConApp directly
 375         -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
 376         -- Here we are relying on checkValidType to find
 377         -- the error.  What we can't do is use mkSynTy with
 378         -- too few arg tys, because that is utterly bogus.
 379
 380   where
 381     mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
 382                         (substTyWith tyvars tys body)
 383
 384     (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
 385     arity          = tyConArity tycon
 386     n_args         = length tys
 387 \end{code}
 388
 389 Notes on type synonyms
 390 ~~~~~~~~~~~~~~~~~~~~~~
 391 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
 392 to return type synonyms whereever possible. Thus
 393
 394         type Foo a = a -> a
 395
 396 we want
 397         splitFunTys (a -> Foo a) = ([a], Foo a)
 398 not                                ([a], a -> a)
 399
 400 The reason is that we then get better (shorter) type signatures in
 401 interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 402
 403
 404                 Representation types
 405                 ~~~~~~~~~~~~~~~~~~~~
 406 repType looks through
 407         (a) for-alls, and
 408         (b) synonyms
 409         (c) predicates
 410         (d) usage annotations
 411         (e) all newtypes, including recursive ones
 412 It's useful in the back end.
 413
 414 \begin{code}
 415 repType :: Type -> Type
 416 -- Only applied to types of kind *; hence tycons are saturated
 417 repType (ForAllTy _ ty)   = repType ty
 418 repType (NoteTy   _ ty)   = repType ty
 419 repType (PredTy  p)       = repType (predTypeRep p)
 420 repType (TyConApp tc tys)
 421   | isNewTyCon tc         = ASSERT( tys `lengthIs` tyConArity tc )
 422                             repType (new_type_rep tc tys)
 423 repType ty                = ty
 424
 425 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 426 -- of inspecting the type directly.
 427 typePrimRep :: Type -> PrimRep
 428 typePrimRep ty = case repType ty of
 429                    TyConApp tc _ -> tyConPrimRep tc
 430                    FunTy _ _     -> PtrRep
 431                    AppTy _ _     -> PtrRep      -- See note below
 432                    TyVarTy _     -> PtrRep
 433                    other         -> pprPanic "typePrimRep" (ppr ty)
 434         -- Types of the form 'f a' must be of kind *, not *#, so
 435         -- we are guaranteed that they are represented by pointers.
 436         -- The reason is that f must have kind *->*, not *->*#, because
 437         -- (we claim) there is no way to constrain f's kind any other
 438         -- way.
 439
 440 -- new_type_rep doesn't ask any questions:
 441 -- it just expands newtype, whether recursive or not
 442 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
 443                              case newTyConRep new_tycon of
 444                                  (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 445 \end{code}
 446
 447
 448 ---------------------------------------------------------------------
 449                                 ForAllTy
 450                                 ~~~~~~~~
 451
 452 \begin{code}
 453 mkForAllTy :: TyVar -> Type -> Type
 454 mkForAllTy tyvar ty
 455   = mkForAllTys [tyvar] ty
 456
 457 mkForAllTys :: [TyVar] -> Type -> Type
 458 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 459
 460 isForAllTy :: Type -> Bool
 461 isForAllTy (NoteTy _ ty)  = isForAllTy ty
 462 isForAllTy (ForAllTy _ _) = True
 463 isForAllTy other_ty       = False
 464
 465 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 466 splitForAllTy_maybe ty = splitFAT_m ty
 467   where
 468     splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
 469     splitFAT_m (ForAllTy tyvar ty)          = Just(tyvar, ty)
 470     splitFAT_m _                            = Nothing
 471
 472 splitForAllTys :: Type -> ([TyVar], Type)
 473 splitForAllTys ty = split ty ty []
 474    where
 475      split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
 476      split orig_ty (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
 477      split orig_ty t                 tvs = (reverse tvs, orig_ty)
 478
 479 dropForAlls :: Type -> Type
 480 dropForAlls ty = snd (splitForAllTys ty)
 481 \end{code}
 482
 483 -- (mkPiType now in CoreUtils)
 484
 485 applyTy, applyTys
 486 ~~~~~~~~~~~~~~~~~
 487 Instantiate a for-all type with one or more type arguments.
 488 Used when we have a polymorphic function applied to type args:
 489         f t1 t2
 490 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
 491 the expression.
 492
 493 \begin{code}
 494 applyTy :: Type -> Type -> Type
 495 applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
 496 applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
 497 applyTy other            arg = panic "applyTy"
 498
 499 applyTys :: Type -> [Type] -> Type
 500 -- This function is interesting because
 501 --      a) the function may have more for-alls than there are args
 502 --      b) less obviously, it may have fewer for-alls
 503 -- For case (b) think of
 504 --      applyTys (forall a.a) [forall b.b, Int]
 505 -- This really can happen, via dressing up polymorphic types with newtype
 506 -- clothing.  Here's an example:
 507 --      newtype R = R (forall a. a->a)
 508 --      foo = case undefined :: R of
 509 --              R f -> f ()
 510
 511 applyTys orig_fun_ty []      = orig_fun_ty
 512 applyTys orig_fun_ty arg_tys
 513   | n_tvs == n_args     -- The vastly common case
 514   = substTyWith tvs arg_tys rho_ty
 515   | n_tvs > n_args      -- Too many for-alls
 516   = substTyWith (take n_args tvs) arg_tys
 517                 (mkForAllTys (drop n_args tvs) rho_ty)
 518   | otherwise           -- Too many type args
 519   = ASSERT2( n_tvs > 0, ppr orig_fun_ty )       -- Zero case gives infnite loop!
 520     applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
 521              (drop n_tvs arg_tys)
 522   where
 523     (tvs, rho_ty) = splitForAllTys orig_fun_ty
 524     n_tvs = length tvs
 525     n_args = length arg_tys
 526 \end{code}
 527
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection{Source types}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 A "source type" is a type that is a separate type as far as the type checker is
 536 concerned, but which has low-level representation as far as the back end is concerned.
 537
 538 Source types are always lifted.
 539
 540 The key function is predTypeRep which gives the representation of a source type:
 541
 542 \begin{code}
 543 mkPredTy :: PredType -> Type
 544 mkPredTy pred = PredTy pred
 545
 546 mkPredTys :: ThetaType -> [Type]
 547 mkPredTys preds = map PredTy preds
 548
 549 predTypeRep :: PredType -> Type
 550 -- Convert a PredType to its "representation type";
 551 -- the post-type-checking type used by all the Core passes of GHC.
 552 -- Unwraps only the outermost level; for example, the result might
 553 -- be a newtype application
 554 predTypeRep (IParam _ ty)     = ty
 555 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 556         -- Result might be a newtype application, but the consumer will
 557         -- look through that too if necessary
 558 \end{code}
 559
 560
 561 %************************************************************************
 562 %*                                                                      *
 563                 NewTypes
 564 %*                                                                      *
 565 %************************************************************************
 566
 567 \begin{code}
 568 splitRecNewType_maybe :: Type -> Maybe Type
 569 -- Sometimes we want to look through a recursive newtype, and that's what happens here
 570 -- It only strips *one layer* off, so the caller will usually call itself recursively
 571 -- Only applied to types of kind *, hence the newtype is always saturated
 572 splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
 573 splitRecNewType_maybe (TyConApp tc tys)
 574   | isNewTyCon tc
 575   = ASSERT( tys `lengthIs` tyConArity tc )      -- splitRecNewType_maybe only be applied
 576                                                 --      to *types* (of kind *)
 577     ASSERT( isRecursiveTyCon tc )               -- Guaranteed by coreView
 578     case newTyConRhs tc of
 579         (tvs, rep_ty) -> Just (substTyWith tvs tys rep_ty)
 580
 581 splitRecNewType_maybe other = Nothing
 582 \end{code}
 583
 584
 585 %************************************************************************
 586 %*                                                                      *
 587 \subsection{Kinds and free variables}
 588 %*                                                                      *
 589 %************************************************************************
 590
 591 ---------------------------------------------------------------------
 592                 Finding the kind of a type
 593                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 594 \begin{code}
 595 typeKind :: Type -> Kind
 596
 597 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 598 typeKind (TyConApp tycon tys)   = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 599 typeKind (NoteTy _ ty)          = typeKind ty
 600 typeKind (PredTy _)             = liftedTypeKind -- Predicates are always
 601                                                  -- represented by lifted types
 602 typeKind (AppTy fun arg)        = kindFunResult (typeKind fun)
 603 typeKind (FunTy arg res)        = liftedTypeKind
 604 typeKind (ForAllTy tv ty)       = typeKind ty
 605 \end{code}
 606
 607
 608 ---------------------------------------------------------------------
 609                 Free variables of a type
 610                 ~~~~~~~~~~~~~~~~~~~~~~~~
 611 \begin{code}
 612 tyVarsOfType :: Type -> TyVarSet
 613 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 614 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 615 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 616 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty2      -- See note [Syn] below
 617 tyVarsOfType (PredTy sty)               = tyVarsOfPred sty
 618 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 619 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 620 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 621
 622 --                      Note [Syn]
 623 -- Consider
 624 --      type T a = Int
 625 -- What are the free tyvars of (T x)?  Empty, of course!
 626 -- Here's the example that Ralf Laemmel showed me:
 627 --      foo :: (forall a. C u a -> C u a) -> u
 628 --      mappend :: Monoid u => u -> u -> u
 629 --
 630 --      bar :: Monoid u => u
 631 --      bar = foo (\t -> t `mappend` t)
 632 -- We have to generalise at the arg to f, and we don't
 633 -- want to capture the constraint (Monad (C u a)) because
 634 -- it appears to mention a.  Pretty silly, but it was useful to him.
 635
 636
 637 tyVarsOfTypes :: [Type] -> TyVarSet
 638 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 639
 640 tyVarsOfPred :: PredType -> TyVarSet
 641 tyVarsOfPred (IParam _ ty)  = tyVarsOfType ty
 642 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
 643
 644 tyVarsOfTheta :: ThetaType -> TyVarSet
 645 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
 646
 647 -- Add a Note with the free tyvars to the top of the type
 648 addFreeTyVars :: Type -> Type
 649 addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
 650 addFreeTyVars ty                             = NoteTy (FTVNote (tyVarsOfType ty)) ty
 651 \end{code}
 652
 653 %************************************************************************
 654 %*                                                                      *
 655 \subsection{TidyType}
 656 %*                                                                      *
 657 %************************************************************************
 658
 659 tidyTy tidies up a type for printing in an error message, or in
 660 an interface file.
 661
 662 It doesn't change the uniques at all, just the print names.
 663
 664 \begin{code}
 665 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 666 tidyTyVarBndr (tidy_env, subst) tyvar
 667   = case tidyOccName tidy_env (getOccName name) of
 668       (tidy', occ') ->  ((tidy', subst'), tyvar')
 669                     where
 670                         subst' = extendVarEnv subst tyvar tyvar'
 671                         tyvar' = setTyVarName tyvar name'
 672                         name'  = mkInternalName (getUnique name) occ' noSrcLoc
 673                                 -- Note: make a *user* tyvar, so it printes nicely
 674                                 -- Could extract src loc, but no need.
 675   where
 676     name = tyVarName tyvar
 677
 678 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 679 -- Add the free tyvars to the env in tidy form,
 680 -- so that we can tidy the type they are free in
 681 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 682
 683 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 684 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 685
 686 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 687 -- Treat a new tyvar as a binder, and give it a fresh tidy name
 688 tidyOpenTyVar env@(tidy_env, subst) tyvar
 689   = case lookupVarEnv subst tyvar of
 690         Just tyvar' -> (env, tyvar')            -- Already substituted
 691         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 692
 693 tidyType :: TidyEnv -> Type -> Type
 694 tidyType env@(tidy_env, subst) ty
 695   = go ty
 696   where
 697     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 698                                 Nothing  -> TyVarTy tv
 699                                 Just tv' -> TyVarTy tv'
 700     go (TyConApp tycon tys) = let args = map go tys
 701                               in args `seqList` TyConApp tycon args
 702     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 703     go (PredTy sty)         = PredTy (tidyPred env sty)
 704     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 705     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 706     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 707                               where
 708                                 (envp, tvp) = tidyTyVarBndr env tv
 709
 710     go_note (SynNote ty)        = SynNote $! (go ty)
 711     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 712
 713 tidyTypes env tys = map (tidyType env) tys
 714
 715 tidyPred :: TidyEnv -> PredType -> PredType
 716 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 717 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 718 \end{code}
 719
 720
 721 @tidyOpenType@ grabs the free type variables, tidies them
 722 and then uses @tidyType@ to work over the type itself
 723
 724 \begin{code}
 725 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 726 tidyOpenType env ty
 727   = (env', tidyType env' ty)
 728   where
 729     env' = tidyFreeTyVars env (tyVarsOfType ty)
 730
 731 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 732 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 733
 734 tidyTopType :: Type -> Type
 735 tidyTopType ty = tidyType emptyTidyEnv ty
 736 \end{code}
 737
 738
 739
 740 %************************************************************************
 741 %*                                                                      *
 742 \subsection{Liftedness}
 743 %*                                                                      *
 744 %************************************************************************
 745
 746 \begin{code}
 747 isUnLiftedType :: Type -> Bool
 748         -- isUnLiftedType returns True for forall'd unlifted types:
 749         --      x :: forall a. Int#
 750         -- I found bindings like these were getting floated to the top level.
 751         -- They are pretty bogus types, mind you.  It would be better never to
 752         -- construct them
 753
 754 isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
 755 isUnLiftedType (ForAllTy tv ty)  = isUnLiftedType ty
 756 isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
 757 isUnLiftedType other             = False
 758
 759 isUnboxedTupleType :: Type -> Bool
 760 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 761                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
 762                            other              -> False
 763
 764 -- Should only be applied to *types*; hence the assert
 765 isAlgType :: Type -> Bool
 766 isAlgType ty = case splitTyConApp_maybe ty of
 767                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 768                                               isAlgTyCon tc
 769                         other              -> False
 770 \end{code}
 771
 772 @isStrictType@ computes whether an argument (or let RHS) should
 773 be computed strictly or lazily, based only on its type.
 774 Works just like isUnLiftedType, except that it has a special case
 775 for dictionaries.  Since it takes account of ClassP, you might think
 776 this function should be in TcType, but isStrictType is used by DataCon,
 777 which is below TcType in the hierarchy, so it's convenient to put it here.
 778
 779 \begin{code}
 780 isStrictType (PredTy pred)     = isStrictPred pred
 781 isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
 782 isStrictType (ForAllTy tv ty)  = isStrictType ty
 783 isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
 784 isStrictType other             = False
 785
 786 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
 787 isStrictPred other           = False
 788         -- We may be strict in dictionary types, but only if it
 789         -- has more than one component.
 790         -- [Being strict in a single-component dictionary risks
 791         --  poking the dictionary component, which is wrong.]
 792 \end{code}
 793
 794 \begin{code}
 795 isPrimitiveType :: Type -> Bool
 796 -- Returns types that are opaque to Haskell.
 797 -- Most of these are unlifted, but now that we interact with .NET, we
 798 -- may have primtive (foreign-imported) types that are lifted
 799 isPrimitiveType ty = case splitTyConApp_maybe ty of
 800                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 801                                               isPrimTyCon tc
 802                         other              -> False
 803 \end{code}
 804
 805
 806 %************************************************************************
 807 %*                                                                      *
 808 \subsection{Sequencing on types
 809 %*                                                                      *
 810 %************************************************************************
 811
 812 \begin{code}
 813 seqType :: Type -> ()
 814 seqType (TyVarTy tv)      = tv `seq` ()
 815 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
 816 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
 817 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
 818 seqType (PredTy p)        = seqPred p
 819 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
 820 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
 821
 822 seqTypes :: [Type] -> ()
 823 seqTypes []       = ()
 824 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 825
 826 seqNote :: TyNote -> ()
 827 seqNote (SynNote ty)  = seqType ty
 828 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 829
 830 seqPred :: PredType -> ()
 831 seqPred (ClassP c tys) = c  `seq` seqTypes tys
 832 seqPred (IParam n ty)  = n  `seq` seqType ty
 833 \end{code}
 834
 835
 836 %************************************************************************
 837 %*                                                                      *
 838 \subsection{Equality on types}
 839 %*                                                                      *
 840 %************************************************************************
 841
 842 Comparison; don't use instances so that we know where it happens.
 843 Look through newtypes but not usage types.
 844
 845 Note that eqType can respond 'False' for partial applications of newtypes.
 846 Consider
 847         newtype Parser m a = MkParser (Foogle m a)
 848
 849 Does
 850         Monad (Parser m) `eqType` Monad (Foogle m)
 851
 852 Well, yes, but eqType won't see that they are the same.
 853 I don't think this is harmful, but it's soemthing to watch out for.
 854
 855 \begin{code}
 856 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
 857
 858 -- Look through Notes, PredTy, newtype applications
 859 eq_ty env t1 t2 | Just t1' <- coreView t1 = eq_ty env t1' t2
 860 eq_ty env t1 t2 | Just t2' <- coreView t2 = eq_ty env t1 t2'
 861
 862 -- NB: we *cannot* short-cut the newtype comparison thus:
 863 -- eq_ty env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2)
 864 --      | (tc1 == tc2) = (eq_tys env tys1 tys2)
 865 --
 866 -- Consider:
 867 --      newtype T a = MkT [a]
 868 --      newtype Foo m = MkFoo (forall a. m a -> Int)
 869 --      w1 :: Foo []
 870 --      w1 = ...
 871 --
 872 --      w2 :: Foo T
 873 --      w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 874 --
 875 -- We end up with w2 = w1; so we need that Foo T = Foo []
 876 -- but we can only expand saturated newtypes, so just comparing
 877 -- T with [] won't do.
 878
 879 -- The rest is plain sailing
 880 eq_ty env (TyVarTy tv1)       (TyVarTy tv2)       = case lookupVarEnv env tv1 of
 881                                                           Just tv1a -> tv1a == tv2
 882                                                           Nothing   -> tv1  == tv2
 883 eq_ty env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)
 884         | tv1 == tv2                              = eq_ty (delVarEnv env tv1)        t1 t2
 885         | otherwise                               = eq_ty (extendVarEnv env tv1 tv2) t1 t2
 886 eq_ty env (AppTy s1 t1)       (AppTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 887 eq_ty env (FunTy s1 t1)       (FunTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 888 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
 889 eq_ty env t1                   t2                 = False
 890
 891 eq_tys env []        []        = True
 892 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
 893 eq_tys env tys1      tys2      = False
 894 \end{code}
 895
 896
 897 %************************************************************************
 898 %*                                                                      *
 899                 Type substitutions
 900 %*                                                                      *
 901 %************************************************************************
 902
 903 \begin{code}
 904 data TvSubst
 905   = TvSubst InScopeSet  -- The in-scope type variables
 906             TvSubstEnv  -- The substitution itself; guaranteed idempotent
 907                         -- See Note [Apply Once]
 908
 909 {- ----------------------------------------------------------
 910                 Note [Apply Once]
 911
 912 We use TvSubsts to instantiate things, and we might instantiate
 913         forall a b. ty
 914 \with the types
 915         [a, b], or [b, a].
 916 So the substition might go [a->b, b->a].  A similar situation arises in Core
 917 when we find a beta redex like
 918         (/\ a /\ b -> e) b a
 919 Then we also end up with a substition that permutes type variables. Other
 920 variations happen to; for example [a -> (a, b)].
 921
 922         ***************************************************
 923         *** So a TvSubst must be applied precisely once ***
 924         ***************************************************
 925
 926 A TvSubst is not idempotent, but, unlike the non-idempotent substitution
 927 we use during unifications, it must not be repeatedly applied.
 928 -------------------------------------------------------------- -}
 929
 930
 931 type TvSubstEnv = TyVarEnv Type
 932         -- A TvSubstEnv is used both inside a TvSubst (with the apply-once
 933         -- invariant discussed in Note [Apply Once]), and also independently
 934         -- in the middle of matching, and unification (see Types.Unify)
 935         -- So you have to look at the context to know if it's idempotent or
 936         -- apply-once or whatever
 937
 938 emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
 939 isEmptyTvSubst :: TvSubst -> Bool
 940 isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
 941
 942 getTvSubstEnv :: TvSubst -> TvSubstEnv
 943 getTvSubstEnv (TvSubst _ env) = env
 944
 945 getTvInScope :: TvSubst -> InScopeSet
 946 getTvInScope (TvSubst in_scope _) = in_scope
 947
 948 isInScope :: Var -> TvSubst -> Bool
 949 isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
 950
 951 setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
 952 setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
 953
 954 extendTvInScope :: TvSubst -> [Var] -> TvSubst
 955 extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
 956
 957 extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
 958 extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
 959
 960 extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
 961 extendTvSubstList (TvSubst in_scope env) tvs tys
 962   = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
 963
 964 -- mkTvSubst and zipTvSubst generate the in-scope set from
 965 -- the types given; but it's just a thunk so with a bit of luck
 966 -- it'll never be evaluated
 967
 968 mkTvSubst :: TvSubstEnv -> TvSubst
 969 mkTvSubst env
 970   = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
 971
 972 zipTvSubst :: [TyVar] -> [Type] -> TvSubst
 973 zipTvSubst tyvars tys
 974   = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
 975
 976 -- mkTopTvSubst is called when doing top-level substitutions.
 977 -- Here we expect that the free vars of the range of the
 978 -- substitution will be empty.
 979 mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
 980 mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
 981
 982 zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
 983 zipTopTvSubst tyvars tys = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
 984
 985 zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
 986 zipTyEnv tyvars tys
 987 #ifdef DEBUG
 988   | length tyvars /= length tys
 989   = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
 990   | otherwise
 991 #endif
 992   = zip_ty_env tyvars tys emptyVarEnv
 993
 994 -- Later substitutions in the list over-ride earlier ones,
 995 -- but there should be no loops
 996 zip_ty_env []       []       env = env
 997 zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
 998         -- There used to be a special case for when
 999         --      ty == TyVarTy tv
1000         -- (a not-uncommon case) in which case the substitution was dropped.
1001         -- But the type-tidier changes the print-name of a type variable without
1002         -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had
1003         -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.
1004         -- And it happened that t was the type variable of the class.  Post-tiding,
1005         -- it got turned into {Foo t2}.  The ext-core printer expanded this using
1006         -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
1007         -- and so generated a rep type mentioning t not t2.
1008         --
1009         -- Simplest fix is to nuke the "optimisation"
1010
1011 instance Outputable TvSubst where
1012   ppr (TvSubst ins env)
1013     = sep[ ptext SLIT("<TvSubst"),
1014            nest 2 (ptext SLIT("In scope:") <+> ppr ins),
1015            nest 2 (ptext SLIT("Env:") <+> ppr env) ]
1016 \end{code}
1017
1018 %************************************************************************
1019 %*                                                                      *
1020                 Performing type substitutions
1021 %*                                                                      *
1022 %************************************************************************
1023
1024 \begin{code}
1025 substTyWith :: [TyVar] -> [Type] -> Type -> Type
1026 substTyWith tvs tys = substTy (zipTvSubst tvs tys)
1027
1028 substTy :: TvSubst -> Type  -> Type
1029 substTy subst ty | isEmptyTvSubst subst = ty
1030                  | otherwise            = subst_ty subst ty
1031
1032 substTys :: TvSubst -> [Type] -> [Type]
1033 substTys subst tys | isEmptyTvSubst subst = tys
1034                    | otherwise            = map (subst_ty subst) tys
1035
1036 deShadowTy :: Type -> Type              -- Remove any shadowing from the type
1037 deShadowTy ty = subst_ty emptyTvSubst ty
1038
1039 substTheta :: TvSubst -> ThetaType -> ThetaType
1040 substTheta subst theta
1041   | isEmptyTvSubst subst = theta
1042   | otherwise            = map (substPred subst) theta
1043
1044 substPred :: TvSubst -> PredType -> PredType
1045 substPred subst (IParam n ty)     = IParam n (subst_ty subst ty)
1046 substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
1047
1048 -- Note that the in_scope set is poked only if we hit a forall
1049 -- so it may often never be fully computed
1050 subst_ty subst@(TvSubst in_scope env) ty
1051    = go ty
1052   where
1053     go ty@(TyVarTy tv)             = case (lookupVarEnv env tv) of
1054                                         Nothing  -> ty
1055                                         Just ty' -> ty' -- See Note [Apply Once]
1056
1057     go (TyConApp tc tys)           = let args = map go tys
1058                                      in  args `seqList` TyConApp tc args
1059
1060     go (PredTy p)                  = PredTy $! (substPred subst p)
1061
1062     go (NoteTy (SynNote ty1) ty2)  = NoteTy (SynNote $! (go ty1)) $! (go ty2)
1063     go (NoteTy (FTVNote _) ty2)    = go ty2             -- Discard the free tyvar note
1064
1065     go (FunTy arg res)             = (FunTy $! (go arg)) $! (go res)
1066     go (AppTy fun arg)             = mkAppTy (go fun) $! (go arg)
1067                 -- The mkAppTy smart constructor is important
1068                 -- we might be replacing (a Int), represented with App
1069                 -- by [Int], represented with TyConApp
1070     go (ForAllTy tv ty)            = case substTyVar subst tv of
1071                                         (subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
1072
1073 substTyVar :: TvSubst -> TyVar -> (TvSubst, TyVar)
1074 substTyVar subst@(TvSubst in_scope env) old_var
1075   | old_var == new_var  -- No need to clone
1076                         -- But we *must* zap any current substitution for the variable.
1077                         --  For example:
1078                         --      (\x.e) with id_subst = [x |-> e']
1079                         -- Here we must simply zap the substitution for x
1080                         --
1081                         -- The new_id isn't cloned, but it may have a different type
1082                         -- etc, so we must return it, not the old id
1083   = (TvSubst (in_scope `extendInScopeSet` new_var) (delVarEnv env old_var),
1084      new_var)
1085
1086   | otherwise   -- The new binder is in scope so
1087                 -- we'd better rename it away from the in-scope variables
1088                 -- Extending the substitution to do this renaming also
1089                 -- has the (correct) effect of discarding any existing
1090                 -- substitution for that variable
1091   = (TvSubst (in_scope `extendInScopeSet` new_var) (extendVarEnv env old_var (TyVarTy new_var)),
1092      new_var)
1093   where
1094     new_var = uniqAway in_scope old_var
1095         -- The uniqAway part makes sure the new variable is not already in scope
1096 \end{code}
1097
1098