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         -- 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, splitFunTys,
  23         funResultTy, funArgTy, zipFunTys, isFunTy,
  24
  25         mkGenTyConApp, mkTyConApp, mkTyConTy,
  26         tyConAppTyCon, tyConAppArgs,
  27         splitTyConApp_maybe, splitTyConApp,
  28
  29         mkSynTy,
  30
  31         repType, typePrimRep,
  32
  33         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
  34         applyTy, applyTys, isForAllTy, dropForAlls,
  35
  36         -- Source types
  37         predTypeRep, mkPredTy, mkPredTys,
  38
  39         -- Newtypes
  40         splitRecNewType_maybe,
  41
  42         -- Lifting and boxity
  43         isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
  44         isStrictType, isStrictPred,
  45
  46         -- Free variables
  47         tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
  48         typeKind, addFreeTyVars,
  49
  50         -- Tidying up for printing
  51         tidyType,      tidyTypes,
  52         tidyOpenType,  tidyOpenTypes,
  53         tidyTyVarBndr, tidyFreeTyVars,
  54         tidyOpenTyVar, tidyOpenTyVars,
  55         tidyTopType,   tidyPred,
  56
  57         -- Comparison
  58         eqType,
  59
  60         -- Seq
  61         seqType, seqTypes,
  62
  63         -- Pretty-printing
  64         pprType, pprParendType,
  65         pprPred, pprTheta, pprThetaArrow, pprClassPred
  66     ) where
  67
  68 #include "HsVersions.h"
  69
  70 -- We import the representation and primitive functions from TypeRep.
  71 -- Many things are reexported, but not the representation!
  72
  73 import TypeRep
  74
  75 -- Other imports:
  76
  77 import {-# SOURCE #-}   Subst  ( substTyWith )
  78
  79 -- friends:
  80 import Kind
  81 import Var      ( TyVar, tyVarKind, tyVarName, setTyVarName )
  82 import VarEnv
  83 import VarSet
  84
  85 import Name     ( NamedThing(..), mkInternalName, tidyOccName )
  86 import Class    ( Class, classTyCon )
  87 import TyCon    ( TyCon, isRecursiveTyCon, isPrimTyCon,
  88                   isUnboxedTupleTyCon, isUnLiftedTyCon,
  89                   isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
  90                   isAlgTyCon, isSynTyCon, tyConArity,
  91                   tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
  92                 )
  93
  94 -- others
  95 import CmdLineOpts      ( opt_DictsStrict )
  96 import SrcLoc           ( noSrcLoc )
  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 -- ToDo: this could be moved to the code generator, using splitTyConApp instead
 395 -- of inspecting the type directly.
 396 typePrimRep :: Type -> PrimRep
 397 typePrimRep ty = case repType ty of
 398                    TyConApp tc _ -> tyConPrimRep tc
 399                    FunTy _ _     -> PtrRep
 400                    AppTy _ _     -> PtrRep      -- See note below
 401                    TyVarTy _     -> PtrRep
 402                    other         -> pprPanic "typePrimRep" (ppr ty)
 403         -- Types of the form 'f a' must be of kind *, not *#, so
 404         -- we are guaranteed that they are represented by pointers.
 405         -- The reason is that f must have kind *->*, not *->*#, because
 406         -- (we claim) there is no way to constrain f's kind any other
 407         -- way.
 408
 409 -- new_type_rep doesn't ask any questions:
 410 -- it just expands newtype, whether recursive or not
 411 new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
 412                              case newTyConRep new_tycon of
 413                                  (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 414 \end{code}
 415
 416
 417 ---------------------------------------------------------------------
 418                                 ForAllTy
 419                                 ~~~~~~~~
 420
 421 \begin{code}
 422 mkForAllTy :: TyVar -> Type -> Type
 423 mkForAllTy tyvar ty
 424   = mkForAllTys [tyvar] ty
 425
 426 mkForAllTys :: [TyVar] -> Type -> Type
 427 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 428
 429 isForAllTy :: Type -> Bool
 430 isForAllTy (NoteTy _ ty)  = isForAllTy ty
 431 isForAllTy (ForAllTy _ _) = True
 432 isForAllTy other_ty       = False
 433
 434 splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
 435 splitForAllTy_maybe ty = splitFAT_m ty
 436   where
 437     splitFAT_m (NoteTy _ ty)            = splitFAT_m ty
 438     splitFAT_m (PredTy p)               = splitFAT_m (predTypeRep p)
 439     splitFAT_m (NewTcApp tc tys)        = splitFAT_m (newTypeRep tc tys)
 440     splitFAT_m (ForAllTy tyvar ty)      = Just(tyvar, ty)
 441     splitFAT_m _                        = Nothing
 442
 443 splitForAllTys :: Type -> ([TyVar], Type)
 444 splitForAllTys ty = split ty ty []
 445    where
 446      split orig_ty (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
 447      split orig_ty (NoteTy _ ty)     tvs = split orig_ty ty tvs
 448      split orig_ty (PredTy p)        tvs = split orig_ty (predTypeRep p) tvs
 449      split orig_ty (NewTcApp tc tys) tvs = split orig_ty (newTypeRep tc tys) tvs
 450      split orig_ty t                 tvs = (reverse tvs, orig_ty)
 451
 452 dropForAlls :: Type -> Type
 453 dropForAlls ty = snd (splitForAllTys ty)
 454 \end{code}
 455
 456 -- (mkPiType now in CoreUtils)
 457
 458 applyTy, applyTys
 459 ~~~~~~~~~~~~~~~~~
 460 Instantiate a for-all type with one or more type arguments.
 461 Used when we have a polymorphic function applied to type args:
 462         f t1 t2
 463 Then we use (applyTys type-of-f [t1,t2]) to compute the type of
 464 the expression.
 465
 466 \begin{code}
 467 applyTy :: Type -> Type -> Type
 468 applyTy (PredTy p)        arg = applyTy (predTypeRep p) arg
 469 applyTy (NewTcApp tc tys) arg = applyTy (newTypeRep tc tys) arg
 470 applyTy (NoteTy _ fun)    arg = applyTy fun arg
 471 applyTy (ForAllTy tv ty)  arg = substTyWith [tv] [arg] ty
 472 applyTy other             arg = panic "applyTy"
 473
 474 applyTys :: Type -> [Type] -> Type
 475 -- This function is interesting because
 476 --      a) the function may have more for-alls than there are args
 477 --      b) less obviously, it may have fewer for-alls
 478 -- For case (b) think of
 479 --      applyTys (forall a.a) [forall b.b, Int]
 480 -- This really can happen, via dressing up polymorphic types with newtype
 481 -- clothing.  Here's an example:
 482 --      newtype R = R (forall a. a->a)
 483 --      foo = case undefined :: R of
 484 --              R f -> f ()
 485
 486 applyTys orig_fun_ty []      = orig_fun_ty
 487 applyTys orig_fun_ty arg_tys
 488   | n_tvs == n_args     -- The vastly common case
 489   = substTyWith tvs arg_tys rho_ty
 490   | n_tvs > n_args      -- Too many for-alls
 491   = substTyWith (take n_args tvs) arg_tys
 492                 (mkForAllTys (drop n_args tvs) rho_ty)
 493   | otherwise           -- Too many type args
 494   = ASSERT2( n_tvs > 0, ppr orig_fun_ty )       -- Zero case gives infnite loop!
 495     applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
 496              (drop n_tvs arg_tys)
 497   where
 498     (tvs, rho_ty) = splitForAllTys orig_fun_ty
 499     n_tvs = length tvs
 500     n_args = length arg_tys
 501 \end{code}
 502
 503
 504 %************************************************************************
 505 %*                                                                      *
 506 \subsection{Source types}
 507 %*                                                                      *
 508 %************************************************************************
 509
 510 A "source type" is a type that is a separate type as far as the type checker is
 511 concerned, but which has low-level representation as far as the back end is concerned.
 512
 513 Source types are always lifted.
 514
 515 The key function is predTypeRep which gives the representation of a source type:
 516
 517 \begin{code}
 518 mkPredTy :: PredType -> Type
 519 mkPredTy pred = PredTy pred
 520
 521 mkPredTys :: ThetaType -> [Type]
 522 mkPredTys preds = map PredTy preds
 523
 524 predTypeRep :: PredType -> Type
 525 -- Convert a PredType to its "representation type";
 526 -- the post-type-checking type used by all the Core passes of GHC.
 527 -- Unwraps only the outermost level; for example, the result might
 528 -- be a NewTcApp; c.f. newTypeRep
 529 predTypeRep (IParam _ ty)     = ty
 530 predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 531         -- Result might be a NewTcApp, but the consumer will
 532         -- look through that too if necessary
 533 \end{code}
 534
 535
 536 %************************************************************************
 537 %*                                                                      *
 538                 NewTypes
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 \begin{code}
 543 splitRecNewType_maybe :: Type -> Maybe Type
 544 -- Newtypes are always represented by a NewTcApp
 545 -- Sometimes we want to look through a recursive newtype, and that's what happens here
 546 -- It only strips *one layer* off, so the caller will usually call itself recursively
 547 -- Only applied to types of kind *, hence the newtype is always saturated
 548 splitRecNewType_maybe (NoteTy _ ty) = splitRecNewType_maybe ty
 549 splitRecNewType_maybe (PredTy p)    = splitRecNewType_maybe (predTypeRep p)
 550 splitRecNewType_maybe (NewTcApp tc tys)
 551   | isRecursiveTyCon tc
 552   = ASSERT( tys `lengthIs` tyConArity tc && isNewTyCon tc )
 553         -- The assert should hold because splitRecNewType_maybe
 554         -- should only be applied to *types* (of kind *)
 555     Just (new_type_rhs tc tys)
 556 splitRecNewType_maybe other = Nothing
 557
 558 -----------------------------
 559 newTypeRep :: TyCon -> [Type] -> Type
 560 -- A local helper function (not exported)
 561 -- Expands *the outermoset level of* a newtype application to
 562 --      *either* a vanilla TyConApp (recursive newtype, or non-saturated)
 563 --      *or*     the newtype representation (otherwise), meaning the
 564 --                      type written in the RHS of the newtype decl,
 565 --                      which may itself be a newtype
 566 --
 567 -- Example: newtype R = MkR S
 568 --          newtype S = MkS T
 569 --          newtype T = MkT (T -> T)
 570 --   newTypeRep on R gives NewTcApp S
 571 --              on S gives NewTcApp T
 572 --              on T gives TyConApp T
 573 --
 574 -- NB: the returned TyConApp is always deconstructed immediately by the
 575 --     caller... a TyConApp with a newtype type constructor never lives
 576 --     in an ordinary type
 577 newTypeRep tc tys
 578   | not (isRecursiveTyCon tc),          -- Not recursive and saturated
 579     tys `lengthIs` tyConArity tc        -- treat as equivalent to expansion
 580   = new_type_rhs tc tys
 581   | otherwise
 582   = TyConApp tc tys
 583         -- ToDo: Consider caching this substitution in a NType
 584
 585 -- new_type_rhs doesn't ask any questions:
 586 -- it just expands newtype one level, whether recursive or not
 587 new_type_rhs tc tys
 588   = case newTyConRhs tc of
 589         (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 590 \end{code}
 591
 592
 593 %************************************************************************
 594 %*                                                                      *
 595 \subsection{Kinds and free variables}
 596 %*                                                                      *
 597 %************************************************************************
 598
 599 ---------------------------------------------------------------------
 600                 Finding the kind of a type
 601                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 602 \begin{code}
 603 typeKind :: Type -> Kind
 604
 605 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 606 typeKind (TyConApp tycon tys)   = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 607 typeKind (NewTcApp tycon tys)   = foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
 608 typeKind (NoteTy _ ty)          = typeKind ty
 609 typeKind (PredTy _)             = liftedTypeKind -- Predicates are always
 610                                                  -- represented by lifted types
 611 typeKind (AppTy fun arg)        = kindFunResult (typeKind fun)
 612 typeKind (FunTy arg res)        = liftedTypeKind
 613 typeKind (ForAllTy tv ty)       = typeKind ty
 614 \end{code}
 615
 616
 617 ---------------------------------------------------------------------
 618                 Free variables of a type
 619                 ~~~~~~~~~~~~~~~~~~~~~~~~
 620 \begin{code}
 621 tyVarsOfType :: Type -> TyVarSet
 622 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 623 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 624 tyVarsOfType (NewTcApp tycon tys)       = tyVarsOfTypes tys
 625 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 626 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty2      -- See note [Syn] below
 627 tyVarsOfType (PredTy sty)               = tyVarsOfPred sty
 628 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 629 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 630 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 631
 632 --                      Note [Syn]
 633 -- Consider
 634 --      type T a = Int
 635 -- What are the free tyvars of (T x)?  Empty, of course!
 636 -- Here's the example that Ralf Laemmel showed me:
 637 --      foo :: (forall a. C u a -> C u a) -> u
 638 --      mappend :: Monoid u => u -> u -> u
 639 --
 640 --      bar :: Monoid u => u
 641 --      bar = foo (\t -> t `mappend` t)
 642 -- We have to generalise at the arg to f, and we don't
 643 -- want to capture the constraint (Monad (C u a)) because
 644 -- it appears to mention a.  Pretty silly, but it was useful to him.
 645
 646
 647 tyVarsOfTypes :: [Type] -> TyVarSet
 648 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 649
 650 tyVarsOfPred :: PredType -> TyVarSet
 651 tyVarsOfPred (IParam _ ty)  = tyVarsOfType ty
 652 tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
 653
 654 tyVarsOfTheta :: ThetaType -> TyVarSet
 655 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
 656
 657 -- Add a Note with the free tyvars to the top of the type
 658 addFreeTyVars :: Type -> Type
 659 addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
 660 addFreeTyVars ty                             = NoteTy (FTVNote (tyVarsOfType ty)) ty
 661 \end{code}
 662
 663 %************************************************************************
 664 %*                                                                      *
 665 \subsection{TidyType}
 666 %*                                                                      *
 667 %************************************************************************
 668
 669 tidyTy tidies up a type for printing in an error message, or in
 670 an interface file.
 671
 672 It doesn't change the uniques at all, just the print names.
 673
 674 \begin{code}
 675 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 676 tidyTyVarBndr (tidy_env, subst) tyvar
 677   = case tidyOccName tidy_env (getOccName name) of
 678       (tidy', occ') ->  ((tidy', subst'), tyvar')
 679                     where
 680                         subst' = extendVarEnv subst tyvar tyvar'
 681                         tyvar' = setTyVarName tyvar name'
 682                         name'  = mkInternalName (getUnique name) occ' noSrcLoc
 683                                 -- Note: make a *user* tyvar, so it printes nicely
 684                                 -- Could extract src loc, but no need.
 685   where
 686     name = tyVarName tyvar
 687
 688 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 689 -- Add the free tyvars to the env in tidy form,
 690 -- so that we can tidy the type they are free in
 691 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 692
 693 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 694 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 695
 696 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 697 -- Treat a new tyvar as a binder, and give it a fresh tidy name
 698 tidyOpenTyVar env@(tidy_env, subst) tyvar
 699   = case lookupVarEnv subst tyvar of
 700         Just tyvar' -> (env, tyvar')            -- Already substituted
 701         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 702
 703 tidyType :: TidyEnv -> Type -> Type
 704 tidyType env@(tidy_env, subst) ty
 705   = go ty
 706   where
 707     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 708                                 Nothing  -> TyVarTy tv
 709                                 Just tv' -> TyVarTy tv'
 710     go (TyConApp tycon tys) = let args = map go tys
 711                               in args `seqList` TyConApp tycon args
 712     go (NewTcApp tycon tys) = let args = map go tys
 713                               in args `seqList` NewTcApp tycon args
 714     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 715     go (PredTy sty)         = PredTy (tidyPred env sty)
 716     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 717     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 718     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 719                               where
 720                                 (envp, tvp) = tidyTyVarBndr env tv
 721
 722     go_note (SynNote ty)        = SynNote $! (go ty)
 723     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 724
 725 tidyTypes env tys = map (tidyType env) tys
 726
 727 tidyPred :: TidyEnv -> PredType -> PredType
 728 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 729 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 730 \end{code}
 731
 732
 733 @tidyOpenType@ grabs the free type variables, tidies them
 734 and then uses @tidyType@ to work over the type itself
 735
 736 \begin{code}
 737 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 738 tidyOpenType env ty
 739   = (env', tidyType env' ty)
 740   where
 741     env' = tidyFreeTyVars env (tyVarsOfType ty)
 742
 743 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 744 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 745
 746 tidyTopType :: Type -> Type
 747 tidyTopType ty = tidyType emptyTidyEnv ty
 748 \end{code}
 749
 750
 751
 752 %************************************************************************
 753 %*                                                                      *
 754 \subsection{Liftedness}
 755 %*                                                                      *
 756 %************************************************************************
 757
 758 \begin{code}
 759 isUnLiftedType :: Type -> Bool
 760         -- isUnLiftedType returns True for forall'd unlifted types:
 761         --      x :: forall a. Int#
 762         -- I found bindings like these were getting floated to the top level.
 763         -- They are pretty bogus types, mind you.  It would be better never to
 764         -- construct them
 765
 766 isUnLiftedType (ForAllTy tv ty)  = isUnLiftedType ty
 767 isUnLiftedType (NoteTy _ ty)     = isUnLiftedType ty
 768 isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
 769 isUnLiftedType (PredTy _)        = False                -- All source types are lifted
 770 isUnLiftedType (NewTcApp tc tys) = isUnLiftedType (newTypeRep tc tys)
 771 isUnLiftedType other             = False
 772
 773 isUnboxedTupleType :: Type -> Bool
 774 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 775                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
 776                            other              -> False
 777
 778 -- Should only be applied to *types*; hence the assert
 779 isAlgType :: Type -> Bool
 780 isAlgType ty = case splitTyConApp_maybe ty of
 781                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 782                                               isAlgTyCon tc
 783                         other              -> False
 784 \end{code}
 785
 786 @isStrictType@ computes whether an argument (or let RHS) should
 787 be computed strictly or lazily, based only on its type.
 788 Works just like isUnLiftedType, except that it has a special case
 789 for dictionaries.  Since it takes account of ClassP, you might think
 790 this function should be in TcType, but isStrictType is used by DataCon,
 791 which is below TcType in the hierarchy, so it's convenient to put it here.
 792
 793 \begin{code}
 794 isStrictType (ForAllTy tv ty)  = isStrictType ty
 795 isStrictType (NoteTy _ ty)     = isStrictType ty
 796 isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
 797 isStrictType (NewTcApp tc tys) = isStrictType (newTypeRep tc tys)
 798 isStrictType (PredTy pred)     = isStrictPred pred
 799 isStrictType other             = False
 800
 801 isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
 802 isStrictPred other           = False
 803         -- We may be strict in dictionary types, but only if it
 804         -- has more than one component.
 805         -- [Being strict in a single-component dictionary risks
 806         --  poking the dictionary component, which is wrong.]
 807 \end{code}
 808
 809 \begin{code}
 810 isPrimitiveType :: Type -> Bool
 811 -- Returns types that are opaque to Haskell.
 812 -- Most of these are unlifted, but now that we interact with .NET, we
 813 -- may have primtive (foreign-imported) types that are lifted
 814 isPrimitiveType ty = case splitTyConApp_maybe ty of
 815                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 816                                               isPrimTyCon tc
 817                         other              -> False
 818 \end{code}
 819
 820
 821 %************************************************************************
 822 %*                                                                      *
 823 \subsection{Sequencing on types
 824 %*                                                                      *
 825 %************************************************************************
 826
 827 \begin{code}
 828 seqType :: Type -> ()
 829 seqType (TyVarTy tv)      = tv `seq` ()
 830 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
 831 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
 832 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
 833 seqType (PredTy p)        = seqPred p
 834 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
 835 seqType (NewTcApp tc tys) = tc `seq` seqTypes tys
 836 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
 837
 838 seqTypes :: [Type] -> ()
 839 seqTypes []       = ()
 840 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 841
 842 seqNote :: TyNote -> ()
 843 seqNote (SynNote ty)  = seqType ty
 844 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 845
 846 seqPred :: PredType -> ()
 847 seqPred (ClassP c tys) = c  `seq` seqTypes tys
 848 seqPred (IParam n ty)  = n  `seq` seqType ty
 849 \end{code}
 850
 851
 852 %************************************************************************
 853 %*                                                                      *
 854 \subsection{Equality on types}
 855 %*                                                                      *
 856 %************************************************************************
 857
 858 Comparison; don't use instances so that we know where it happens.
 859 Look through newtypes but not usage types.
 860
 861 Note that eqType can respond 'False' for partial applications of newtypes.
 862 Consider
 863         newtype Parser m a = MkParser (Foogle m a)
 864
 865 Does
 866         Monad (Parser m) `eqType` Monad (Foogle m)
 867
 868 Well, yes, but eqType won't see that they are the same.
 869 I don't think this is harmful, but it's soemthing to watch out for.
 870
 871 \begin{code}
 872 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
 873
 874 -- Look through Notes
 875 eq_ty env (NoteTy _ t1)       t2                  = eq_ty env t1 t2
 876 eq_ty env t1                  (NoteTy _ t2)       = eq_ty env t1 t2
 877
 878 -- Look through PredTy and NewTcApp.  This is where the looping danger comes from.
 879 -- We don't bother to check for the PredType/PredType case, no good reason
 880 -- Hmm: maybe there is a good reason: see the notes below about newtypes
 881 eq_ty env (PredTy sty1)     t2            = eq_ty env (predTypeRep sty1) t2
 882 eq_ty env t1                (PredTy sty2) = eq_ty env t1 (predTypeRep sty2)
 883
 884 -- NB: we *cannot* short-cut the newtype comparison thus:
 885 -- eq_ty env (NewTcApp tc1 tys1) (NewTcApp tc2 tys2)
 886 --      | (tc1 == tc2) = (eq_tys env tys1 tys2)
 887 --
 888 -- Consider:
 889 --      newtype T a = MkT [a]
 890 --      newtype Foo m = MkFoo (forall a. m a -> Int)
 891 --      w1 :: Foo []
 892 --      w1 = ...
 893 --
 894 --      w2 :: Foo T
 895 --      w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
 896 --
 897 -- We end up with w2 = w1; so we need that Foo T = Foo []
 898 -- but we can only expand saturated newtypes, so just comparing
 899 -- T with [] won't do.
 900
 901 eq_ty env (NewTcApp tc1 tys1) t2                  = eq_ty env (newTypeRep tc1 tys1) t2
 902 eq_ty env t1                  (NewTcApp tc2 tys2) = eq_ty env t1 (newTypeRep tc2 tys2)
 903
 904 -- The rest is plain sailing
 905 eq_ty env (TyVarTy tv1)       (TyVarTy tv2)       = case lookupVarEnv env tv1 of
 906                                                           Just tv1a -> tv1a == tv2
 907                                                           Nothing   -> tv1  == tv2
 908 eq_ty env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)
 909         | tv1 == tv2                              = eq_ty (delVarEnv env tv1)        t1 t2
 910         | otherwise                               = eq_ty (extendVarEnv env tv1 tv2) t1 t2
 911 eq_ty env (AppTy s1 t1)       (AppTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 912 eq_ty env (FunTy s1 t1)       (FunTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 913 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
 914 eq_ty env t1                   t2                 = False
 915
 916 eq_tys env []        []        = True
 917 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
 918 eq_tys env tys1      tys2      = False
 919 \end{code}
 920