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, TyVarSubst,
  10         funTyCon,
  11
  12         -- Re-exports from Kind
  13         module Kind,
  14
  15
  16         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
  17
  18         mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
  19
  20         mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, splitFunTys,
  21         funResultTy, funArgTy, zipFunTys, isFunTy,
  22
  23         mkGenTyConApp, mkTyConApp, mkTyConTy,
  24         tyConAppTyCon, tyConAppArgs,
  25         splitTyConApp_maybe, splitTyConApp,
  26
  27         mkSynTy,
  28
  29         repType, typePrimRep,
  30
  31         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
  32         applyTy, applyTys, isForAllTy, dropForAlls,
  33
  34         -- Source types
  35         predTypeRep, mkPredTy, mkPredTys,
  36
  37         -- Newtypes
  38         splitRecNewType_maybe,
  39
  40         -- Lifting and boxity
  41         isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
  42         isStrictType, isStrictPred,
  43
  44         -- Free variables
  45         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
  46         typeKind, addFreeTyVars,
  47
  48         -- Tidying up for printing
  49         tidyType,      tidyTypes,
  50         tidyOpenType,  tidyOpenTypes,
  51         tidyTyVarBndr, tidyFreeTyVars,
  52         tidyOpenTyVar, tidyOpenTyVars,
  53         tidyTopType,   tidyPred,
  54
  55         -- Comparison
  56         eqType,
  57
  58         -- Seq
  59         seqType, seqTypes,
  60
  61         -- Pretty-printing
  62         pprType, pprParendType,
  63         pprPred, pprTheta, pprThetaArrow, pprClassPred
  64     ) where
  65
  66 #include "HsVersions.h"
  67
  68 -- We import the representation and primitive functions from TypeRep.
  69 -- Many things are reexported, but not the representation!
  70
  71 import TypeRep
  72
  73 -- Other imports:
  74
  75 import {-# SOURCE #-}   Subst  ( substTyWith )
  76
  77 -- friends:
  78 import Kind
  79 import Var      ( TyVar, tyVarKind, tyVarName, setTyVarName )
  80 import VarEnv
  81 import VarSet
  82
  83 import Name     ( NamedThing(..), mkInternalName, tidyOccName )
  84 import Class    ( Class, classTyCon )
  85 import TyCon    ( TyCon, isRecursiveTyCon, isPrimTyCon,
  86                   isUnboxedTupleTyCon, isUnLiftedTyCon,
  87                   isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
  88                   isAlgTyCon, isSynTyCon, tyConArity,
  89                   tyConKind, getSynTyConDefn,
  90                   tyConPrimRep,
  91                 )
  92
  93 -- others
  94 import CmdLineOpts      ( opt_DictsStrict )
  95 import SrcLoc           ( noSrcLoc )
  96 import PrimRep          ( PrimRep(..) )
  97 import Unique           ( Uniquable(..) )
  98 import Util             ( mapAccumL, seqList, lengthIs, snocView )
  99 import Outputable
 100 import UniqSet          ( sizeUniqSet )         -- Should come via VarSet
 101 import Maybe            ( isJust )
 102 \end{code}
 103
 104
 105 %************************************************************************
 106 %*                                                                      *
 107 \subsection{Constructor-specific functions}
 108 %*                                                                      *
 109 %************************************************************************
 110
 111
 112 ---------------------------------------------------------------------
 113                                 TyVarTy
 114                                 ~~~~~~~
 115 \begin{code}
 116 mkTyVarTy  :: TyVar   -> Type
 117 mkTyVarTy  = TyVarTy
 118
 119 mkTyVarTys :: [TyVar] -> [Type]
 120 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 121
 122 getTyVar :: String -> Type -> TyVar
 123 getTyVar msg ty = case getTyVar_maybe ty of
 124                     Just tv -> tv
 125                     Nothing -> panic ("getTyVar: " ++ msg)
 126
 127 isTyVarTy :: Type -> Bool
 128 isTyVarTy ty = isJust (getTyVar_maybe ty)
 129
 130 getTyVar_maybe :: Type -> Maybe TyVar
 131 getTyVar_maybe (TyVarTy tv)      = Just tv
 132 getTyVar_maybe (NoteTy _ t)      = getTyVar_maybe t
 133 getTyVar_maybe (PredTy p)        = getTyVar_maybe (predTypeRep p)
 134 getTyVar_maybe (NewTcApp tc tys) = getTyVar_maybe (newTypeRep tc tys)
 135 getTyVar_maybe other             = Nothing
 136 \end{code}
 137
 138
 139 ---------------------------------------------------------------------
 140                                 AppTy
 141                                 ~~~~~
 142 We need to be pretty careful with AppTy to make sure we obey the
 143 invariant that a TyConApp is always visibly so.  mkAppTy maintains the
 144 invariant: use it.
 145
 146 \begin{code}
 147 mkAppTy orig_ty1 orig_ty2
 148   = mk_app orig_ty1
 149   where
 150     mk_app (NoteTy _ ty1)    = mk_app ty1
 151     mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ [orig_ty2])
 152     mk_app (TyConApp tc tys) = mkGenTyConApp tc (tys ++ [orig_ty2])
 153     mk_app ty1               = AppTy orig_ty1 orig_ty2
 154         -- We call mkGenTyConApp because the TyConApp could be an
 155         -- under-saturated type synonym.  GHC allows that; e.g.
 156         --      type Foo k = k a -> k a
 157         --      type Id x = x
 158         --      foo :: Foo Id -> Foo Id
 159         --
 160         -- Here Id is partially applied in the type sig for Foo,
 161         -- but once the type synonyms are expanded all is well
 162
 163 mkAppTys :: Type -> [Type] -> Type
 164 mkAppTys orig_ty1 []        = orig_ty1
 165         -- This check for an empty list of type arguments
 166         -- avoids the needless loss of a type synonym constructor.
 167         -- For example: mkAppTys Rational []
 168         --   returns to (Ratio Integer), which has needlessly lost
 169         --   the Rational part.
 170 mkAppTys orig_ty1 orig_tys2
 171   = mk_app orig_ty1
 172   where
 173     mk_app (NoteTy _ ty1)    = mk_app ty1
 174     mk_app (NewTcApp tc tys) = NewTcApp tc (tys ++ orig_tys2)
 175     mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
 176                                 -- Use mkTyConApp in case tc is (->)
 177     mk_app ty1               = foldl AppTy orig_ty1 orig_tys2
 178
 179 splitAppTy_maybe :: Type -> Maybe (Type, Type)
 180 splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 181 splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 182 splitAppTy_maybe (NoteTy _ ty)     = splitAppTy_maybe ty
 183 splitAppTy_maybe (PredTy p)        = splitAppTy_maybe (predTypeRep p)
 184 splitAppTy_maybe (NewTcApp tc tys) = splitAppTy_maybe (newTypeRep tc tys)
 185 splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
 186                                         Nothing -> Nothing
 187                                         Just (tys',ty') -> Just (mkGenTyConApp tc tys', ty')
 188                                                 -- mkGenTyConApp just in case the tc is a newtype
 189
 190 splitAppTy_maybe other             = Nothing
 191
 192 splitAppTy :: Type -> (Type, Type)
 193 splitAppTy ty = case splitAppTy_maybe ty of
 194                         Just pr -> pr
 195                         Nothing -> panic "splitAppTy"
 196
 197 splitAppTys :: Type -> (Type, [Type])
 198 splitAppTys ty = split ty ty []
 199   where
 200     split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
 201     split orig_ty (NoteTy _ ty)         args = split orig_ty ty args
 202     split orig_ty (PredTy p)            args = split orig_ty (predTypeRep p) args
 203     split orig_ty (NewTcApp tc tc_args) args = split orig_ty (newTypeRep tc tc_args) args
 204     split orig_ty (TyConApp tc tc_args) args = (mkGenTyConApp tc [], tc_args ++ args)
 205                                                 -- mkGenTyConApp just in case the tc is a newtype
 206     split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
 207                                                (TyConApp funTyCon [], [ty1,ty2])
 208     split orig_ty ty                    args = (orig_ty, args)
 209 \end{code}
 210
 211
 212 ---------------------------------------------------------------------
 213                                 FunTy
 214                                 ~~~~~
 215
 216 \begin{code}
 217 mkFunTy :: Type -> Type -> Type
 218 mkFunTy arg res = FunTy arg res
 219
 220 mkFunTys :: [Type] -> Type -> Type
 221 mkFunTys tys ty = foldr FunTy ty tys
 222
 223 isFunTy :: Type -> Bool
 224 isFunTy ty = isJust (splitFunTy_maybe ty)
 225
 226 splitFunTy :: Type -> (Type, Type)
 227 splitFunTy (FunTy arg res)   = (arg, res)
 228 splitFunTy (NoteTy _ ty)     = splitFunTy ty
 229 splitFunTy (PredTy p)        = splitFunTy (predTypeRep p)
 230 splitFunTy (NewTcApp tc tys) = splitFunTy (newTypeRep tc tys)
 231 splitFunTy other             = pprPanic "splitFunTy" (ppr other)
 232
 233 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 234 splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
 235 splitFunTy_maybe (NoteTy _ ty)     = splitFunTy_maybe ty
 236 splitFunTy_maybe (PredTy p)        = splitFunTy_maybe (predTypeRep p)
 237 splitFunTy_maybe (NewTcApp tc tys) = splitFunTy_maybe (newTypeRep tc tys)
 238 splitFunTy_maybe other             = Nothing
 239
 240 splitFunTys :: Type -> ([Type], Type)
 241 splitFunTys ty = split [] ty ty
 242   where
 243     split args orig_ty (FunTy arg res)   = split (arg:args) res res
 244     split args orig_ty (NoteTy _ ty)     = split args orig_ty ty
 245     split args orig_ty (PredTy p)        = split args orig_ty (predTypeRep p)
 246     split args orig_ty (NewTcApp tc tys) = split args orig_ty (newTypeRep tc tys)
 247     split args orig_ty ty                = (reverse args, orig_ty)
 248
 249 zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
 250 zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
 251   where
 252     split acc []     nty ty                = (reverse acc, nty)
 253     split acc (x:xs) nty (FunTy arg res)   = split ((x,arg):acc) xs res res
 254     split acc xs     nty (NoteTy _ ty)     = split acc           xs nty ty
 255     split acc xs     nty (PredTy p)        = split acc           xs nty (predTypeRep p)
 256     split acc xs     nty (NewTcApp tc tys) = split acc           xs nty (newTypeRep tc tys)
 257     split acc (x:xs) nty ty                = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
 258
 259 funResultTy :: Type -> Type
 260 funResultTy (FunTy arg res)   = res
 261 funResultTy (NoteTy _ ty)     = funResultTy ty
 262 funResultTy (PredTy p)        = funResultTy (predTypeRep p)
 263 funResultTy (NewTcApp tc tys) = funResultTy (newTypeRep tc tys)
 264 funResultTy ty                = pprPanic "funResultTy" (ppr ty)
 265
 266 funArgTy :: Type -> Type
 267 funArgTy (FunTy arg res)   = arg
 268 funArgTy (NoteTy _ ty)     = funArgTy ty
 269 funArgTy (PredTy p)        = funArgTy (predTypeRep p)
 270 funArgTy (NewTcApp tc tys) = funArgTy (newTypeRep tc tys)
 271 funArgTy ty                = pprPanic "funArgTy" (ppr ty)
 272 \end{code}
 273
 274
 275 ---------------------------------------------------------------------
 276                                 TyConApp
 277                                 ~~~~~~~~
 278 @mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
 279 as apppropriate.
 280
 281 \begin{code}
 282 mkGenTyConApp :: TyCon -> [Type] -> Type
 283 mkGenTyConApp tc tys
 284   | isSynTyCon tc = mkSynTy tc tys
 285   | otherwise     = mkTyConApp tc tys
 286
 287 mkTyConApp :: TyCon -> [Type] -> Type
 288 -- Assumes TyCon is not a SynTyCon; use mkSynTy instead for those
 289 mkTyConApp tycon tys
 290   | isFunTyCon tycon, [ty1,ty2] <- tys
 291   = FunTy ty1 ty2
 292
 293   | isNewTyCon tycon
 294   = NewTcApp tycon tys
 295
 296   | otherwise
 297   = ASSERT(not (isSynTyCon tycon))
 298     TyConApp tycon tys
 299
 300 mkTyConTy :: TyCon -> Type
 301 mkTyConTy tycon = mkTyConApp tycon []
 302
 303 -- splitTyConApp "looks through" synonyms, because they don't
 304 -- mean a distinct type, but all other type-constructor applications
 305 -- including functions are returned as Just ..
 306
 307 tyConAppTyCon :: Type -> TyCon
 308 tyConAppTyCon ty = fst (splitTyConApp ty)
 309
 310 tyConAppArgs :: Type -> [Type]
 311 tyConAppArgs ty = snd (splitTyConApp ty)
 312
 313 splitTyConApp :: Type -> (TyCon, [Type])
 314 splitTyConApp ty = case splitTyConApp_maybe ty of
 315                         Just stuff -> stuff
 316                         Nothing    -> pprPanic "splitTyConApp" (ppr ty)
 317
 318 splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 319 splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 320 splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 321 splitTyConApp_maybe (NoteTy _ ty)     = splitTyConApp_maybe ty
 322 splitTyConApp_maybe (PredTy p)        = splitTyConApp_maybe (predTypeRep p)
 323 splitTyConApp_maybe (NewTcApp tc tys) = splitTyConApp_maybe (newTypeRep tc tys)
 324 splitTyConApp_maybe other             = Nothing
 325 \end{code}
 326
 327
 328 ---------------------------------------------------------------------
 329                                 SynTy
 330                                 ~~~~~
 331
 332 \begin{code}
 333 mkSynTy tycon tys
 334   | n_args == arity     -- Exactly saturated
 335   = mk_syn tys
 336   | n_args >  arity     -- Over-saturated
 337   = case splitAt arity tys of { (as,bs) -> mkAppTys (mk_syn as) bs }
 338         -- Its important to use mkAppTys, rather than (foldl AppTy),
 339         -- because (mk_syn as) might well return a partially-applied
 340         -- type constructor; indeed, usually will!
 341   | otherwise           -- Un-saturated
 342   = TyConApp tycon tys
 343         -- For the un-saturated case we build TyConApp directly
 344         -- (mkTyConApp ASSERTs that the tc isn't a SynTyCon).
 345         -- Here we are relying on checkValidType to find
 346         -- the error.  What we can't do is use mkSynTy with
 347         -- too few arg tys, because that is utterly bogus.
 348
 349   where
 350     mk_syn tys = NoteTy (SynNote (TyConApp tycon tys))
 351                         (substTyWith tyvars tys body)
 352
 353     (tyvars, body) = ASSERT( isSynTyCon tycon ) getSynTyConDefn tycon
 354     arity          = tyConArity tycon
 355     n_args         = length tys
 356 \end{code}
 357
 358 Notes on type synonyms
 359 ~~~~~~~~~~~~~~~~~~~~~~
 360 The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
 361 to return type synonyms whereever possible. Thus
 362
 363         type Foo a = a -> a
 364
 365 we want
 366         splitFunTys (a -> Foo a) = ([a], Foo a)
 367 not                                ([a], a -> a)
 368
 369 The reason is that we then get better (shorter) type signatures in
 370 interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
 371
 372
 373                 Representation types
 374                 ~~~~~~~~~~~~~~~~~~~~
 375 repType looks through
 376         (a) for-alls, and
 377         (b) synonyms
 378         (c) predicates
 379         (d) usage annotations
 380         (e) [recursive] newtypes
 381 It's useful in the back end.
 382
 383 \begin{code}
 384 repType :: Type -> Type
 385 -- Only applied to types of kind *; hence tycons are saturated
 386 repType (ForAllTy _ ty)   = repType ty
 387 repType (NoteTy   _ ty)   = repType ty
 388 repType (PredTy  p)       = repType (predTypeRep p)
 389 repType (NewTcApp tc tys) = ASSERT( tys `lengthIs` tyConArity tc )
 390                             repType (new_type_rep tc tys)
 391 repType ty                = ty
 392
 393
 394 typePrimRep :: Type -> PrimRep
 395 typePrimRep ty = case repType ty of
 396                    TyConApp tc _ -> tyConPrimRep tc
 397                    FunTy _ _     -> PtrRep
 398                    AppTy _ _     -> PtrRep      -- ??
 399                    TyVarTy _     -> PtrRep
 400                    other         -> pprPanic "typePrimRep" (ppr ty)
 401
 402 -- new_type_rep doesn't ask any questions:
 403 -- it just expands newtype, whether recursive or not
 404 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
 405                              case newTyConRep new_tycon of
 406                                  (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 407 \end{code}
 408
 409
 410
 411 ---------------------------------------------------------------------
 412                                 ForAllTy
 413                                 ~~~~~~~~
 414
 415 \begin{code}
 416 mkForAllTy :: TyVar -> Type -> Type
 417 mkForAllTy tyvar ty
 418   = mkForAllTys [tyvar] ty
 419
 420 mkForAllTys :: [TyVar] -> Type -> Type
 421 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 422
 423 isForAllTy :: Type -> Bool
 424 isForAllTy (NoteTy _ ty)  = isForAllTy ty
 425 isForAllTy (ForAllTy _ _) = True
 426 isForAllTy other_ty       = False
 427
 428 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 429 splitForAllTy_maybe ty = splitFAT_m ty
 430   where
 431     splitFAT_m (NoteTy _ ty)            = splitFAT_m ty
 432     splitFAT_m (PredTy p)               = splitFAT_m (predTypeRep p)
 433     splitFAT_m (NewTcApp tc tys)        = splitFAT_m (newTypeRep tc tys)
 434     splitFAT_m (ForAllTy tyvar ty)      = Just(tyvar, ty)
 435     splitFAT_m _                        = Nothing
 436
 437 splitForAllTys :: Type -> ([TyVar], Type)
 438 splitForAllTys ty = split ty ty []
 439    where
 440      split orig_ty (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
 441      split orig_ty (NoteTy _ ty)     tvs = split orig_ty ty tvs
 442      split orig_ty (PredTy p)        tvs = split orig_ty (predTypeRep p) tvs
 443      split orig_ty (NewTcApp tc tys) tvs = split orig_ty (newTypeRep tc tys) tvs
 444      split orig_ty t                 tvs = (reverse tvs, orig_ty)
 445
 446 dropForAlls :: Type -> Type
 447 dropForAlls ty = snd (splitForAllTys ty)
 448 \end{code}
 449
 450 -- (mkPiType now in CoreUtils)
 451
 452 applyTy, applyTys
 453 ~~~~~~~~~~~~~~~~~
 454 Instantiate a for-all type with one or more type arguments.
 455 Used when we have a polymorphic function applied to type args:
 456         f t1 t2
 457 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
 458 the expression.
 459
 460 \begin{code}
 461 applyTy :: Type -> Type -> Type
 462 applyTy (PredTy p)        arg = applyTy (predTypeRep p) arg
 463 applyTy (NewTcApp tc tys) arg = applyTy (newTypeRep tc tys) arg
 464 applyTy (NoteTy _ fun)    arg = applyTy fun arg
 465 applyTy (ForAllTy tv ty)  arg = substTyWith [tv] [arg] ty
 466 applyTy other             arg = panic "applyTy"
 467
 468 applyTys :: Type -> [Type] -> Type
 469 -- This function is interesting because
 470 --      a) the function may have more for-alls than there are args
 471 --      b) less obviously, it may have fewer for-alls
 472 -- For case (b) think of
 473 --      applyTys (forall a.a) [forall b.b, Int]
 474 -- This really can happen, via dressing up polymorphic types with newtype
 475 -- clothing.  Here's an example:
 476 --      newtype R = R (forall a. a->a)
 477 --      foo = case undefined :: R of
 478 --              R f -> f ()
 479
 480 applyTys orig_fun_ty []      = orig_fun_ty
 481 applyTys orig_fun_ty arg_tys
 482   | n_tvs == n_args     -- The vastly common case
 483   = substTyWith tvs arg_tys rho_ty
 484   | n_tvs > n_args      -- Too many for-alls
 485   = substTyWith (take n_args tvs) arg_tys
 486                 (mkForAllTys (drop n_args tvs) rho_ty)
 487   | otherwise           -- Too many type args
 488   = ASSERT2( n_tvs > 0, ppr orig_fun_ty )       -- Zero case gives infnite loop!
 489     applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
 490              (drop n_tvs arg_tys)
 491   where
 492     (tvs, rho_ty) = splitForAllTys orig_fun_ty
 493     n_tvs = length tvs
 494     n_args = length arg_tys
 495 \end{code}
 496
 497
 498 %************************************************************************
 499 %*                                                                      *
 500 \subsection{Source types}
 501 %*                                                                      *
 502 %************************************************************************
 503
 504 A "source type" is a type that is a separate type as far as the type checker is
 505 concerned, but which has low-level representation as far as the back end is concerned.
 506
 507 Source types are always lifted.
 508
 509 The key function is predTypeRep which gives the representation of a source type:
 510
 511 \begin{code}
 512 mkPredTy :: PredType -> Type
 513 mkPredTy pred = PredTy pred
 514
 515 mkPredTys :: ThetaType -> [Type]
 516 mkPredTys preds = map PredTy preds
 517
 518 predTypeRep :: PredType -> Type
 519 -- Convert a PredType to its "representation type";
 520 -- the post-type-checking type used by all the Core passes of GHC.
 521 -- Unwraps only the outermost level; for example, the result might
 522 -- be a NewTcApp; c.f. newTypeRep
 523 predTypeRep (IParam _ ty)     = ty
 524 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 525         -- Result might be a NewTcApp, but the consumer will
 526         -- look through that too if necessary
 527 \end{code}
 528
 529
 530 %************************************************************************
 531 %*                                                                      *
 532                 NewTypes
 533 %*                                                                      *
 534 %************************************************************************
 535
 536 \begin{code}
 537 splitRecNewType_maybe :: Type -> Maybe Type
 538 -- Newtypes are always represented by a NewTcApp
 539 -- Sometimes we want to look through a recursive newtype, and that's what happens here
 540 -- It only strips *one layer* off, so the caller will usually call itself recursively
 541 -- Only applied to types of kind *, hence the newtype is always saturated
 542 splitRecNewType_maybe (NoteTy _ ty) = splitRecNewType_maybe ty
 543 splitRecNewType_maybe (PredTy p)    = splitRecNewType_maybe (predTypeRep p)
 544 splitRecNewType_maybe (NewTcApp tc tys)
 545   | isRecursiveTyCon tc
 546   = ASSERT( tys `lengthIs` tyConArity tc && isNewTyCon tc )
 547         -- The assert should hold because splitRecNewType_maybe
 548         -- should only be applied to *types* (of kind *)
 549     Just (new_type_rhs tc tys)
 550 splitRecNewType_maybe other = Nothing
 551
 552 -----------------------------
 553 newTypeRep :: TyCon -> [Type] -> Type
 554 -- A local helper function (not exported)
 555 -- Expands *the outermoset level of* a newtype application to
 556 --      *either* a vanilla TyConApp (recursive newtype, or non-saturated)
 557 --      *or*     the newtype representation (otherwise), meaning the
 558 --                      type written in the RHS of the newtype decl,
 559 --                      which may itself be a newtype
 560 --
 561 -- Example: newtype R = MkR S
 562 --          newtype S = MkS T
 563 --          newtype T = MkT (T -> T)
 564 --   newTypeRep on R gives NewTcApp S
 565 --              on S gives NewTcApp T
 566 --              on T gives TyConApp T
 567 --
 568 -- NB: the returned TyConApp is always deconstructed immediately by the
 569 --     caller... a TyConApp with a newtype type constructor never lives
 570 --     in an ordinary type
 571 newTypeRep tc tys
 572   | not (isRecursiveTyCon tc),          -- Not recursive and saturated
 573     tys `lengthIs` tyConArity tc        -- treat as equivalent to expansion
 574   = new_type_rhs tc tys
 575   | otherwise
 576   = TyConApp tc tys
 577         -- ToDo: Consider caching this substitution in a NType
 578
 579 -- new_type_rhs doesn't ask any questions:
 580 -- it just expands newtype one level, whether recursive or not
 581 new_type_rhs tc tys
 582   = case newTyConRhs tc of
 583         (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 584 \end{code}
 585
 586
 587 %************************************************************************
 588 %*                                                                      *
 589 \subsection{Kinds and free variables}
 590 %*                                                                      *
 591 %************************************************************************
 592
 593 ---------------------------------------------------------------------
 594                 Finding the kind of a type
 595                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 596 \begin{code}
 597 typeKind :: Type -> Kind
 598
 599 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 600 typeKind (TyConApp tycon tys)   = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 601 typeKind (NewTcApp tycon tys)   = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 602 typeKind (NoteTy _ ty)          = typeKind ty
 603 typeKind (PredTy _)             = liftedTypeKind -- Predicates are always
 604                                                  -- represented by lifted types
 605 typeKind (AppTy fun arg)        = kindFunResult (typeKind fun)
 606 typeKind (FunTy arg res)        = liftedTypeKind
 607 typeKind (ForAllTy tv ty)       = typeKind ty
 608 \end{code}
 609
 610
 611 ---------------------------------------------------------------------
 612                 Free variables of a type
 613                 ~~~~~~~~~~~~~~~~~~~~~~~~
 614 \begin{code}
 615 tyVarsOfType :: Type -> TyVarSet
 616 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 617 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 618 tyVarsOfType (NewTcApp tycon tys)       = tyVarsOfTypes tys
 619 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 620 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty2      -- See note [Syn] below
 621 tyVarsOfType (PredTy sty)               = tyVarsOfPred sty
 622 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 623 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 624 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 625
 626 --                      Note [Syn]
 627 -- Consider
 628 --      type T a = Int
 629 -- What are the free tyvars of (T x)?  Empty, of course!
 630 -- Here's the example that Ralf Laemmel showed me:
 631 --      foo :: (forall a. C u a -> C u a) -> u
 632 --      mappend :: Monoid u => u -> u -> u
 633 --
 634 --      bar :: Monoid u => u
 635 --      bar = foo (\t -> t `mappend` t)
 636 -- We have to generalise at the arg to f, and we don't
 637 -- want to capture the constraint (Monad (C u a)) because
 638 -- it appears to mention a.  Pretty silly, but it was useful to him.
 639
 640
 641 tyVarsOfTypes :: [Type] -> TyVarSet
 642 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 643
 644 tyVarsOfPred :: PredType -> TyVarSet
 645 tyVarsOfPred (IParam _ ty)  = tyVarsOfType ty
 646 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
 647
 648 tyVarsOfTheta :: ThetaType -> TyVarSet
 649 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
 650
 651 -- Add a Note with the free tyvars to the top of the type
 652 addFreeTyVars :: Type -> Type
 653 addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
 654 addFreeTyVars ty                             = NoteTy (FTVNote (tyVarsOfType ty)) ty
 655 \end{code}
 656
 657 %************************************************************************
 658 %*                                                                      *
 659 \subsection{TidyType}
 660 %*                                                                      *
 661 %************************************************************************
 662
 663 tidyTy tidies up a type for printing in an error message, or in
 664 an interface file.
 665
 666 It doesn't change the uniques at all, just the print names.
 667
 668 \begin{code}
 669 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 670 tidyTyVarBndr (tidy_env, subst) tyvar
 671   = case tidyOccName tidy_env (getOccName name) of
 672       (tidy', occ') ->  ((tidy', subst'), tyvar')
 673                     where
 674                         subst' = extendVarEnv subst tyvar tyvar'
 675                         tyvar' = setTyVarName tyvar name'
 676                         name'  = mkInternalName (getUnique name) occ' noSrcLoc
 677                                 -- Note: make a *user* tyvar, so it printes nicely
 678                                 -- Could extract src loc, but no need.
 679   where
 680     name = tyVarName tyvar
 681
 682 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 683 -- Add the free tyvars to the env in tidy form,
 684 -- so that we can tidy the type they are free in
 685 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 686
 687 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 688 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 689
 690 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 691 -- Treat a new tyvar as a binder, and give it a fresh tidy name
 692 tidyOpenTyVar env@(tidy_env, subst) tyvar
 693   = case lookupVarEnv subst tyvar of
 694         Just tyvar' -> (env, tyvar')            -- Already substituted
 695         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 696
 697 tidyType :: TidyEnv -> Type -> Type
 698 tidyType env@(tidy_env, subst) ty
 699   = go ty
 700   where
 701     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 702                                 Nothing  -> TyVarTy tv
 703                                 Just tv' -> TyVarTy tv'
 704     go (TyConApp tycon tys) = let args = map go tys
 705                               in args `seqList` TyConApp tycon args
 706     go (NewTcApp tycon tys) = let args = map go tys
 707                               in args `seqList` NewTcApp tycon args
 708     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 709     go (PredTy sty)         = PredTy (tidyPred env sty)
 710     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 711     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 712     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 713                               where
 714                                 (envp, tvp) = tidyTyVarBndr env tv
 715
 716     go_note (SynNote ty)        = SynNote $! (go ty)
 717     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 718
 719 tidyTypes env tys = map (tidyType env) tys
 720
 721 tidyPred :: TidyEnv -> PredType -> PredType
 722 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 723 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 724 \end{code}
 725
 726
 727 @tidyOpenType@ grabs the free type variables, tidies them
 728 and then uses @tidyType@ to work over the type itself
 729
 730 \begin{code}
 731 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 732 tidyOpenType env ty
 733   = (env', tidyType env' ty)
 734   where
 735     env' = tidyFreeTyVars env (tyVarsOfType ty)
 736
 737 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 738 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 739
 740 tidyTopType :: Type -> Type
 741 tidyTopType ty = tidyType emptyTidyEnv ty
 742 \end{code}
 743
 744
 745
 746 %************************************************************************
 747 %*                                                                      *
 748 \subsection{Liftedness}
 749 %*                                                                      *
 750 %************************************************************************
 751
 752 \begin{code}
 753 isUnLiftedType :: Type -> Bool
 754         -- isUnLiftedType returns True for forall'd unlifted types:
 755         --      x :: forall a. Int#
 756         -- I found bindings like these were getting floated to the top level.
 757         -- They are pretty bogus types, mind you.  It would be better never to
 758         -- construct them
 759
 760 isUnLiftedType (ForAllTy tv ty)  = isUnLiftedType ty
 761 isUnLiftedType (NoteTy _ ty)     = isUnLiftedType ty
 762 isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
 763 isUnLiftedType (PredTy _)        = False                -- All source types are lifted
 764 isUnLiftedType (NewTcApp tc tys) = isUnLiftedType (newTypeRep tc tys)
 765 isUnLiftedType other             = False
 766
 767 isUnboxedTupleType :: Type -> Bool
 768 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 769                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
 770                            other              -> False
 771
 772 -- Should only be applied to *types*; hence the assert
 773 isAlgType :: Type -> Bool
 774 isAlgType ty = case splitTyConApp_maybe ty of
 775                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 776                                               isAlgTyCon tc
 777                         other              -> False
 778 \end{code}
 779
 780 @isStrictType@ computes whether an argument (or let RHS) should
 781 be computed strictly or lazily, based only on its type.
 782 Works just like isUnLiftedType, except that it has a special case
 783 for dictionaries.  Since it takes account of ClassP, you might think
 784 this function should be in TcType, but isStrictType is used by DataCon,
 785 which is below TcType in the hierarchy, so it's convenient to put it here.
 786
 787 \begin{code}
 788 isStrictType (ForAllTy tv ty)  = isStrictType ty
 789 isStrictType (NoteTy _ ty)     = isStrictType ty
 790 isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
 791 isStrictType (NewTcApp tc tys) = isStrictType (newTypeRep tc tys)
 792 isStrictType (PredTy pred)     = isStrictPred pred
 793 isStrictType other             = False
 794
 795 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
 796 isStrictPred other           = False
 797         -- We may be strict in dictionary types, but only if it
 798         -- has more than one component.
 799         -- [Being strict in a single-component dictionary risks
 800         --  poking the dictionary component, which is wrong.]
 801 \end{code}
 802
 803 \begin{code}
 804 isPrimitiveType :: Type -> Bool
 805 -- Returns types that are opaque to Haskell.
 806 -- Most of these are unlifted, but now that we interact with .NET, we
 807 -- may have primtive (foreign-imported) types that are lifted
 808 isPrimitiveType ty = case splitTyConApp_maybe ty of
 809                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 810                                               isPrimTyCon tc
 811                         other              -> False
 812 \end{code}
 813
 814
 815 %************************************************************************
 816 %*                                                                      *
 817 \subsection{Sequencing on types
 818 %*                                                                      *
 819 %************************************************************************
 820
 821 \begin{code}
 822 seqType :: Type -> ()
 823 seqType (TyVarTy tv)      = tv `seq` ()
 824 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
 825 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
 826 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
 827 seqType (PredTy p)        = seqPred p
 828 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
 829 seqType (NewTcApp tc tys) = tc `seq` seqTypes tys
 830 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
 831
 832 seqTypes :: [Type] -> ()
 833 seqTypes []       = ()
 834 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 835
 836 seqNote :: TyNote -> ()
 837 seqNote (SynNote ty)  = seqType ty
 838 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 839
 840 seqPred :: PredType -> ()
 841 seqPred (ClassP c tys) = c  `seq` seqTypes tys
 842 seqPred (IParam n ty)  = n  `seq` seqType ty
 843 \end{code}
 844
 845
 846 %************************************************************************
 847 %*                                                                      *
 848 \subsection{Equality on types}
 849 %*                                                                      *
 850 %************************************************************************
 851
 852 Comparison; don't use instances so that we know where it happens.
 853 Look through newtypes but not usage types.
 854
 855 Note that eqType can respond 'False' for partial applications of newtypes.
 856 Consider
 857         newtype Parser m a = MkParser (Foogle m a)
 858
 859 Does
 860         Monad (Parser m) `eqType` Monad (Foogle m)
 861
 862 Well, yes, but eqType won't see that they are the same.
 863 I don't think this is harmful, but it's soemthing to watch out for.
 864
 865 \begin{code}
 866 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
 867
 868 -- Look through Notes
 869 eq_ty env (NoteTy _ t1)       t2                  = eq_ty env t1 t2
 870 eq_ty env t1                  (NoteTy _ t2)       = eq_ty env t1 t2
 871
 872 -- Look through PredTy and NewTcApp.  This is where the looping danger comes from.
 873 -- We don't bother to check for the PredType/PredType case, no good reason
 874 -- Hmm: maybe there is a good reason: see the notes below about newtypes
 875 eq_ty env (PredTy sty1)     t2            = eq_ty env (predTypeRep sty1) t2
 876 eq_ty env t1                (PredTy sty2) = eq_ty env t1 (predTypeRep sty2)
 877
 878 -- NB: we *cannot* short-cut the newtype comparison thus:
 879 -- eq_ty env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2)
 880 --      | (tc1 == tc2) = (eq_tys env tys1 tys2)
 881 --
 882 -- Consider:
 883 --      newtype T a = MkT [a]
 884 --      newtype Foo m = MkFoo (forall a. m a -> Int)
 885 --      w1 :: Foo []
 886 --      w1 = ...
 887 --
 888 --      w2 :: Foo T
 889 --      w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 890 --
 891 -- We end up with w2 = w1; so we need that Foo T = Foo []
 892 -- but we can only expand saturated newtypes, so just comparing
 893 -- T with [] won't do.
 894
 895 eq_ty env (NewTcApp tc1 tys1) t2                  = eq_ty env (newTypeRep tc1 tys1) t2
 896 eq_ty env t1                  (NewTcApp tc2 tys2) = eq_ty env t1 (newTypeRep tc2 tys2)
 897
 898 -- The rest is plain sailing
 899 eq_ty env (TyVarTy tv1)       (TyVarTy tv2)       = case lookupVarEnv env tv1 of
 900                                                           Just tv1a -> tv1a == tv2
 901                                                           Nothing   -> tv1  == tv2
 902 eq_ty env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)
 903         | tv1 == tv2                              = eq_ty (delVarEnv env tv1)        t1 t2
 904         | otherwise                               = eq_ty (extendVarEnv env tv1 tv2) t1 t2
 905 eq_ty env (AppTy s1 t1)       (AppTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 906 eq_ty env (FunTy s1 t1)       (FunTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 907 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
 908 eq_ty env t1                   t2                 = False
 909
 910 eq_tys env []        []        = True
 911 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
 912 eq_tys env tys1      tys2      = False
 913 \end{code}
 914