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