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