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 fun_ty arg_tys
 494  = substTyWith tvs arg_tys ty
 495  where
 496    (mu, tvs, ty) = split fun_ty arg_tys
 497
 498    split fun_ty               []         = (Nothing, [], 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                                                   (mu, tvs, ty) -> (mu, tv:tvs, ty)
 503    split other_ty             args       = panic "applyTys"
 504 \end{code}
 505
 506
 507 %************************************************************************
 508 %*                                                                      *
 509 \subsection{Source types}
 510 %*                                                                      *
 511 %************************************************************************
 512
 513 A "source type" is a type that is a separate type as far as the type checker is
 514 concerned, but which has low-level representation as far as the back end is concerned.
 515
 516 Source types are always lifted.
 517
 518 The key function is sourceTypeRep which gives the representation of a source type:
 519
 520 \begin{code}
 521 mkPredTy :: PredType -> Type
 522 mkPredTy pred = SourceTy pred
 523
 524 mkPredTys :: ThetaType -> [Type]
 525 mkPredTys preds = map SourceTy preds
 526
 527 sourceTypeRep :: SourceType -> Type
 528 -- Convert a predicate to its "representation type";
 529 -- the type of evidence for that predicate, which is actually passed at runtime
 530 sourceTypeRep (IParam _ ty)     = ty
 531 sourceTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
 532         -- Note the mkTyConApp; the classTyCon might be a newtype!
 533 sourceTypeRep (NType  tc tys)   = newTypeRep tc tys
 534         -- ToDo: Consider caching this substitution in a NType
 535
 536 isSourceTy :: Type -> Bool
 537 isSourceTy (NoteTy _ ty)  = isSourceTy ty
 538 isSourceTy (SourceTy sty) = True
 539 isSourceTy _              = False
 540
 541
 542 splitNewType_maybe :: Type -> Maybe Type
 543 -- Newtypes that are recursive are reprsented by TyConApp, just
 544 -- as they always were.  Occasionally we want to find their representation type.
 545 -- NB: remember that in this module, non-recursive newtypes are transparent
 546
 547 splitNewType_maybe ty
 548   = case splitTyConApp_maybe ty of
 549         Just (tc,tys) | isNewTyCon tc -> ASSERT( tys `lengthIs` tyConArity tc )
 550                                                 -- The assert should hold because repType should
 551                                                 -- only be applied to *types* (of kind *)
 552                                          Just (newTypeRep tc tys)
 553         other -> Nothing
 554
 555 -- A local helper function (not exported)
 556 newTypeRep new_tycon tys = case newTyConRep new_tycon of
 557                              (tvs, rep_ty) -> substTyWith tvs tys rep_ty
 558 \end{code}
 559
 560
 561 %************************************************************************
 562 %*                                                                      *
 563 \subsection{Kinds and free variables}
 564 %*                                                                      *
 565 %************************************************************************
 566
 567 ---------------------------------------------------------------------
 568                 Finding the kind of a type
 569                 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 570 \begin{code}
 571 typeKind :: Type -> Kind
 572
 573 typeKind (TyVarTy tyvar)        = tyVarKind tyvar
 574 typeKind (TyConApp tycon tys)   = foldr (\_ k -> funResultTy k) (tyConKind tycon) tys
 575 typeKind (NoteTy _ ty)          = typeKind ty
 576 typeKind (SourceTy _)           = liftedTypeKind -- Predicates are always
 577                                                  -- represented by lifted types
 578 typeKind (AppTy fun arg)        = funResultTy (typeKind fun)
 579
 580 typeKind (FunTy arg res)        = fix_up (typeKind res)
 581                                 where
 582                                   fix_up (TyConApp tycon _) |  tycon == typeCon
 583                                                             || tycon == openKindCon = liftedTypeKind
 584                                   fix_up (NoteTy _ kind) = fix_up kind
 585                                   fix_up kind            = kind
 586                 -- The basic story is
 587                 --      typeKind (FunTy arg res) = typeKind res
 588                 -- But a function is lifted regardless of its result type
 589                 -- Hence the strange fix-up.
 590                 -- Note that 'res', being the result of a FunTy, can't have
 591                 -- a strange kind like (*->*).
 592
 593 typeKind (ForAllTy tv ty)       = typeKind ty
 594 \end{code}
 595
 596
 597 ---------------------------------------------------------------------
 598                 Free variables of a type
 599                 ~~~~~~~~~~~~~~~~~~~~~~~~
 600 \begin{code}
 601 tyVarsOfType :: Type -> TyVarSet
 602 tyVarsOfType (TyVarTy tv)               = unitVarSet tv
 603 tyVarsOfType (TyConApp tycon tys)       = tyVarsOfTypes tys
 604 tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
 605 tyVarsOfType (NoteTy (SynNote ty1) ty2) = tyVarsOfType ty1
 606 tyVarsOfType (SourceTy sty)             = tyVarsOfSourceType sty
 607 tyVarsOfType (FunTy arg res)            = tyVarsOfType arg `unionVarSet` tyVarsOfType res
 608 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionVarSet` tyVarsOfType arg
 609 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusVarSet` unitVarSet tyvar
 610
 611 tyVarsOfTypes :: [Type] -> TyVarSet
 612 tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
 613
 614 tyVarsOfPred :: PredType -> TyVarSet
 615 tyVarsOfPred = tyVarsOfSourceType       -- Just a subtype
 616
 617 tyVarsOfSourceType :: SourceType -> TyVarSet
 618 tyVarsOfSourceType (IParam _ ty)  = tyVarsOfType ty
 619 tyVarsOfSourceType (ClassP _ tys) = tyVarsOfTypes tys
 620 tyVarsOfSourceType (NType _ tys)  = tyVarsOfTypes tys
 621
 622 tyVarsOfTheta :: ThetaType -> TyVarSet
 623 tyVarsOfTheta = foldr (unionVarSet . tyVarsOfSourceType) emptyVarSet
 624
 625 -- Add a Note with the free tyvars to the top of the type
 626 addFreeTyVars :: Type -> Type
 627 addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
 628 addFreeTyVars ty                             = NoteTy (FTVNote (tyVarsOfType ty)) ty
 629 \end{code}
 630
 631
 632
 633 %************************************************************************
 634 %*                                                                      *
 635 \subsection{TidyType}
 636 %*                                                                      *
 637 %************************************************************************
 638
 639 tidyTy tidies up a type for printing in an error message, or in
 640 an interface file.
 641
 642 It doesn't change the uniques at all, just the print names.
 643
 644 \begin{code}
 645 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 646 tidyTyVarBndr (tidy_env, subst) tyvar
 647   = case tidyOccName tidy_env (getOccName name) of
 648       (tidy', occ') ->  -- New occname reqd
 649                         ((tidy', subst'), tyvar')
 650                     where
 651                         subst' = extendVarEnv subst tyvar tyvar'
 652                         tyvar' = setTyVarName tyvar name'
 653                         name'  = mkInternalName (getUnique name) occ' noSrcLoc
 654                                 -- Note: make a *user* tyvar, so it printes nicely
 655                                 -- Could extract src loc, but no need.
 656   where
 657     name = tyVarName tyvar
 658
 659 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 660 -- Add the free tyvars to the env in tidy form,
 661 -- so that we can tidy the type they are free in
 662 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 663
 664 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 665 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 666
 667 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 668 -- Treat a new tyvar as a binder, and give it a fresh tidy name
 669 tidyOpenTyVar env@(tidy_env, subst) tyvar
 670   = case lookupVarEnv subst tyvar of
 671         Just tyvar' -> (env, tyvar')            -- Already substituted
 672         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 673
 674 tidyType :: TidyEnv -> Type -> Type
 675 tidyType env@(tidy_env, subst) ty
 676   = go ty
 677   where
 678     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 679                                 Nothing  -> TyVarTy tv
 680                                 Just tv' -> TyVarTy tv'
 681     go (TyConApp tycon tys) = let args = map go tys
 682                               in args `seqList` TyConApp tycon args
 683     go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
 684     go (SourceTy sty)       = SourceTy (tidySourceType env sty)
 685     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 686     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 687     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 688                               where
 689                                 (envp, tvp) = tidyTyVarBndr env tv
 690
 691     go_note (SynNote ty)        = SynNote $! (go ty)
 692     go_note note@(FTVNote ftvs) = note  -- No need to tidy the free tyvars
 693
 694 tidyTypes env tys = map (tidyType env) tys
 695
 696 tidyPred :: TidyEnv -> SourceType -> SourceType
 697 tidyPred = tidySourceType
 698
 699 tidySourceType :: TidyEnv -> SourceType -> SourceType
 700 tidySourceType env (IParam n ty)     = IParam n (tidyType env ty)
 701 tidySourceType env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 702 tidySourceType env (NType tc tys)    = NType  tc   (tidyTypes env tys)
 703 \end{code}
 704
 705
 706 @tidyOpenType@ grabs the free type variables, tidies them
 707 and then uses @tidyType@ to work over the type itself
 708
 709 \begin{code}
 710 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 711 tidyOpenType env ty
 712   = (env', tidyType env' ty)
 713   where
 714     env' = tidyFreeTyVars env (tyVarsOfType ty)
 715
 716 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 717 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 718
 719 tidyTopType :: Type -> Type
 720 tidyTopType ty = tidyType emptyTidyEnv ty
 721 \end{code}
 722
 723
 724
 725 %************************************************************************
 726 %*                                                                      *
 727 \subsection{Liftedness}
 728 %*                                                                      *
 729 %************************************************************************
 730
 731 \begin{code}
 732 isUnLiftedType :: Type -> Bool
 733         -- isUnLiftedType returns True for forall'd unlifted types:
 734         --      x :: forall a. Int#
 735         -- I found bindings like these were getting floated to the top level.
 736         -- They are pretty bogus types, mind you.  It would be better never to
 737         -- construct them
 738
 739 isUnLiftedType (ForAllTy tv ty) = isUnLiftedType ty
 740 isUnLiftedType (NoteTy _ ty)    = isUnLiftedType ty
 741 isUnLiftedType (TyConApp tc _)  = isUnLiftedTyCon tc
 742 isUnLiftedType (SourceTy _)     = False         -- All source types are lifted
 743 isUnLiftedType other            = False
 744
 745 isUnboxedTupleType :: Type -> Bool
 746 isUnboxedTupleType ty = case splitTyConApp_maybe ty of
 747                            Just (tc, ty_args) -> isUnboxedTupleTyCon tc
 748                            other              -> False
 749
 750 -- Should only be applied to *types*; hence the assert
 751 isAlgType :: Type -> Bool
 752 isAlgType ty = case splitTyConApp_maybe ty of
 753                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 754                                               isAlgTyCon tc
 755                         other              -> False
 756 \end{code}
 757
 758 @isStrictType@ computes whether an argument (or let RHS) should
 759 be computed strictly or lazily, based only on its type.
 760 Works just like isUnLiftedType, except that it has a special case
 761 for dictionaries.  Since it takes account of ClassP, you might think
 762 this function should be in TcType, but isStrictType is used by DataCon,
 763 which is below TcType in the hierarchy, so it's convenient to put it here.
 764
 765 \begin{code}
 766 isStrictType (ForAllTy tv ty)           = isStrictType ty
 767 isStrictType (NoteTy _ ty)              = isStrictType ty
 768 isStrictType (TyConApp tc _)            = isUnLiftedTyCon tc
 769 isStrictType (SourceTy (ClassP clas _)) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
 770         -- We may be strict in dictionary types, but only if it
 771         -- has more than one component.
 772         -- [Being strict in a single-component dictionary risks
 773         --  poking the dictionary component, which is wrong.]
 774 isStrictType other                      = False
 775 \end{code}
 776
 777 \begin{code}
 778 isPrimitiveType :: Type -> Bool
 779 -- Returns types that are opaque to Haskell.
 780 -- Most of these are unlifted, but now that we interact with .NET, we
 781 -- may have primtive (foreign-imported) types that are lifted
 782 isPrimitiveType ty = case splitTyConApp_maybe ty of
 783                         Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
 784                                               isPrimTyCon tc
 785                         other              -> False
 786 \end{code}
 787
 788
 789 %************************************************************************
 790 %*                                                                      *
 791 \subsection{Sequencing on types
 792 %*                                                                      *
 793 %************************************************************************
 794
 795 \begin{code}
 796 seqType :: Type -> ()
 797 seqType (TyVarTy tv)      = tv `seq` ()
 798 seqType (AppTy t1 t2)     = seqType t1 `seq` seqType t2
 799 seqType (FunTy t1 t2)     = seqType t1 `seq` seqType t2
 800 seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
 801 seqType (SourceTy p)      = seqPred p
 802 seqType (TyConApp tc tys) = tc `seq` seqTypes tys
 803 seqType (ForAllTy tv ty)  = tv `seq` seqType ty
 804
 805 seqTypes :: [Type] -> ()
 806 seqTypes []       = ()
 807 seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
 808
 809 seqNote :: TyNote -> ()
 810 seqNote (SynNote ty)  = seqType ty
 811 seqNote (FTVNote set) = sizeUniqSet set `seq` ()
 812
 813 seqPred :: SourceType -> ()
 814 seqPred (ClassP c tys) = c  `seq` seqTypes tys
 815 seqPred (NType tc tys) = tc `seq` seqTypes tys
 816 seqPred (IParam n ty)  = n  `seq` seqType ty
 817 \end{code}
 818
 819
 820 %************************************************************************
 821 %*                                                                      *
 822 \subsection{Equality on types}
 823 %*                                                                      *
 824 %************************************************************************
 825
 826 Comparison; don't use instances so that we know where it happens.
 827 Look through newtypes but not usage types.
 828
 829 Note that eqType can respond 'False' for partial applications of newtypes.
 830 Consider
 831         newtype Parser m a = MkParser (Foogle m a)
 832
 833 Does
 834         Monad (Parser m) `eqType` Monad (Foogle m)
 835
 836 Well, yes, but eqType won't see that they are the same.
 837 I don't think this is harmful, but it's soemthing to watch out for.
 838
 839 \begin{code}
 840 eqType t1 t2 = eq_ty emptyVarEnv t1 t2
 841 eqKind  = eqType        -- No worries about looking
 842 eqUsage = eqType        -- through source types for these two
 843
 844 -- Look through Notes
 845 eq_ty env (NoteTy _ t1)       t2                  = eq_ty env t1 t2
 846 eq_ty env t1                  (NoteTy _ t2)       = eq_ty env t1 t2
 847
 848 -- Look through SourceTy.  This is where the looping danger comes from
 849 eq_ty env (SourceTy sty1)     t2                  = eq_ty env (sourceTypeRep sty1) t2
 850 eq_ty env t1                  (SourceTy sty2)     = eq_ty env t1 (sourceTypeRep sty2)
 851
 852 -- The rest is plain sailing
 853 eq_ty env (TyVarTy tv1)       (TyVarTy tv2)       = case lookupVarEnv env tv1 of
 854                                                           Just tv1a -> tv1a == tv2
 855                                                           Nothing   -> tv1  == tv2
 856 eq_ty env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)
 857         | tv1 == tv2                              = eq_ty (delVarEnv env tv1)        t1 t2
 858         | otherwise                               = eq_ty (extendVarEnv env tv1 tv2) t1 t2
 859 eq_ty env (AppTy s1 t1)       (AppTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 860 eq_ty env (FunTy s1 t1)       (FunTy s2 t2)       = (eq_ty env s1 s2) && (eq_ty env t1 t2)
 861 eq_ty env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 == tc2) && (eq_tys env tys1 tys2)
 862 eq_ty env t1                   t2                 = False
 863
 864 eq_tys env []        []        = True
 865 eq_tys env (t1:tys1) (t2:tys2) = (eq_ty env t1 t2) && (eq_tys env tys1 tys2)
 866 eq_tys env tys1      tys2      = False
 867 \end{code}
 868