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