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