ghc/compiler/types/Type.lhs

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