compiler/typecheck/TcType.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[TcType]{Types used in the typechecker}
   6
   7 This module provides the Type interface for front-end parts of the
   8 compiler.  These parts
   9
  10         * treat "source types" as opaque:
  11                 newtypes, and predicates are meaningful.
  12         * look through usage types
  13
  14 The "tc" prefix is for "TypeChecker", because the type checker
  15 is the principal client.
  16
  17 \begin{code}
  18 module TcType (
  19   --------------------------------
  20   -- Types
  21   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
  22   TcCoercion, TcTyVar, TcTyVarSet, TcKind, TcCoVar,
  23
  24   --------------------------------
  25   -- MetaDetails
  26   UserTypeCtxt(..), pprUserTypeCtxt,
  27   TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
  28   MetaDetails(Flexi, Indirect), MetaInfo(..),
  29   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy,
  30   isSigTyVar, isOverlappableTyVar,  isTyConableTyVar,
  31   metaTvRef,
  32   isFlexi, isIndirect, isRuntimeUnkSkol,
  33
  34   --------------------------------
  35   -- Builders
  36   mkPhiTy, mkSigmaTy,
  37
  38   --------------------------------
  39   -- Splitters
  40   -- These are important because they do not look through newtypes
  41   tcView,
  42   tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
  43   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
  44   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
  45   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
  46   tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
  47   tcGetTyVar_maybe, tcGetTyVar,
  48   tcSplitSigmaTy, tcDeepSplitSigmaTy_maybe,
  49
  50   ---------------------------------
  51   -- Predicates.
  52   -- Again, newtypes are opaque
  53   eqType, eqTypes, eqPred, cmpType, cmpTypes, cmpPred, eqTypeX,
  54   eqKind,
  55   isSigmaTy, isOverloadedTy,
  56   isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
  57   isIntegerTy, isBoolTy, isUnitTy, isCharTy,
  58   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
  59   isSynFamilyTyConApp,
  60
  61   ---------------------------------
  62   -- Misc type manipulators
  63   deNoteType,
  64   orphNamesOfType, orphNamesOfDFunHead, orphNamesOfCo,
  65   getDFunTyKey,
  66
  67   ---------------------------------
  68   -- Predicate types
  69   mkMinimalBySCs, transSuperClasses, immSuperClasses,
  70
  71   -- * Tidying type related things up for printing
  72   tidyType,      tidyTypes,
  73   tidyOpenType,  tidyOpenTypes,
  74   tidyTyVarBndr, tidyFreeTyVars,
  75   tidyOpenTyVar, tidyOpenTyVars,
  76   tidyTopType,   tidyPred,
  77   tidyKind,
  78   tidyCo, tidyCos,
  79
  80   ---------------------------------
  81   -- Foreign import and export
  82   isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
  83   isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
  84   isFFIExportResultTy, -- :: Type -> Bool
  85   isFFIExternalTy,     -- :: Type -> Bool
  86   isFFIDynArgumentTy,  -- :: Type -> Bool
  87   isFFIDynResultTy,    -- :: Type -> Bool
  88   isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
  89   isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool
  90   isFFILabelTy,        -- :: Type -> Bool
  91   isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
  92   isFFIDotnetObjTy,    -- :: Type -> Bool
  93   isFFITy,             -- :: Type -> Bool
  94   isFunPtrTy,          -- :: Type -> Bool
  95   tcSplitIOType_maybe, -- :: Type -> Maybe Type
  96
  97   --------------------------------
  98   -- Rexported from Kind
  99   Kind, typeKind,
 100   unliftedTypeKind, liftedTypeKind, argTypeKind,
 101   openTypeKind, mkArrowKind, mkArrowKinds,
 102   isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
 103   isSubArgTypeKind, isSubKind, splitKindFunTys, defaultKind,
 104   kindVarRef, mkKindVar,
 105
 106   --------------------------------
 107   -- Rexported from Type
 108   Type, Pred(..), PredType, ThetaType,
 109   mkForAllTy, mkForAllTys,
 110   mkFunTy, mkFunTys, zipFunTys,
 111   mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
 112   mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
 113
 114   getClassPredTys_maybe, getClassPredTys,
 115   isClassPred, isTyVarClassPred, isEqPred,
 116   mkClassPred, mkIPPred, splitPredTy_maybe,
 117   mkDictTy, isPredTy, isDictTy, isDictLikeTy,
 118   tcSplitDFunTy, tcSplitDFunHead,
 119   isIPPred, mkEqPred,
 120
 121   -- Type substitutions
 122   TvSubst(..),  -- Representation visible to a few friends
 123   TvSubstEnv, emptyTvSubst,
 124   mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst,
 125   mkTopTvSubst, notElemTvSubst, unionTvSubst,
 126   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
 127   Type.lookupTyVar, Type.extendTvSubst, Type.substTyVarBndr,
 128   extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
 129   Type.substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars,
 130
 131   isUnLiftedType,       -- Source types are always lifted
 132   isUnboxedTupleType,   -- Ditto
 133   isPrimitiveType,
 134
 135   tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
 136   tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
 137   exactTyVarsOfTypes,
 138
 139   pprKind, pprParendKind,
 140   pprType, pprParendType, pprTypeApp, pprTyThingCategory,
 141   pprPred, pprTheta, pprThetaArrow, pprThetaArrowTy, pprClassPred
 142
 143   ) where
 144
 145 #include "HsVersions.h"
 146
 147 -- friends:
 148 import Kind
 149 import TypeRep
 150 import Class
 151 import Var
 152 import ForeignCall
 153 import VarSet
 154 import Type
 155 import Coercion
 156 import TyCon
 157
 158 -- others:
 159 import DynFlags
 160 import Name hiding (varName)
 161 import NameSet
 162 import VarEnv
 163 import PrelNames
 164 import TysWiredIn
 165 import BasicTypes
 166 import Util
 167 import Maybes
 168 import ListSetOps
 169 import Outputable
 170 import FastString
 171
 172 import Data.List( mapAccumL )
 173 import Data.IORef
 174 \end{code}
 175
 176 %************************************************************************
 177 %*                                                                      *
 178 \subsection{Types}
 179 %*                                                                      *
 180 %************************************************************************
 181
 182 The type checker divides the generic Type world into the
 183 following more structured beasts:
 184
 185 sigma ::= forall tyvars. phi
 186         -- A sigma type is a qualified type
 187         --
 188         -- Note that even if 'tyvars' is empty, theta
 189         -- may not be: e.g.   (?x::Int) => Int
 190
 191         -- Note that 'sigma' is in prenex form:
 192         -- all the foralls are at the front.
 193         -- A 'phi' type has no foralls to the right of
 194         -- an arrow
 195
 196 phi :: theta => rho
 197
 198 rho ::= sigma -> rho
 199      |  tau
 200
 201 -- A 'tau' type has no quantification anywhere
 202 -- Note that the args of a type constructor must be taus
 203 tau ::= tyvar
 204      |  tycon tau_1 .. tau_n
 205      |  tau_1 tau_2
 206      |  tau_1 -> tau_2
 207
 208 -- In all cases, a (saturated) type synonym application is legal,
 209 -- provided it expands to the required form.
 210
 211 \begin{code}
 212 type TcTyVar = TyVar    -- Used only during type inference
 213 type TcCoVar = CoVar    -- Used only during type inference; mutable
 214 type TcType = Type      -- A TcType can have mutable type variables
 215         -- Invariant on ForAllTy in TcTypes:
 216         --      forall a. T
 217         -- a cannot occur inside a MutTyVar in T; that is,
 218         -- T is "flattened" before quantifying over a
 219
 220 type TcCoercion = Coercion  -- A TcCoercion can contain TcTypes.
 221
 222 -- These types do not have boxy type variables in them
 223 type TcPredType     = PredType
 224 type TcThetaType    = ThetaType
 225 type TcSigmaType    = TcType
 226 type TcRhoType      = TcType
 227 type TcTauType      = TcType
 228 type TcKind         = Kind
 229 type TcTyVarSet     = TyVarSet
 230 \end{code}
 231
 232
 233 %************************************************************************
 234 %*                                                                      *
 235 \subsection{TyVarDetails}
 236 %*                                                                      *
 237 %************************************************************************
 238
 239 TyVarDetails gives extra info about type variables, used during type
 240 checking.  It's attached to mutable type variables only.
 241 It's knot-tied back to Var.lhs.  There is no reason in principle
 242 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
 243
 244
 245 Note [Signature skolems]
 246 ~~~~~~~~~~~~~~~~~~~~~~~~
 247 Consider this
 248
 249   x :: [a]
 250   y :: b
 251   (x,y,z) = ([y,z], z, head x)
 252
 253 Here, x and y have type sigs, which go into the environment.  We used to
 254 instantiate their types with skolem constants, and push those types into
 255 the RHS, so we'd typecheck the RHS with type
 256         ( [a*], b*, c )
 257 where a*, b* are skolem constants, and c is an ordinary meta type varible.
 258
 259 The trouble is that the occurrences of z in the RHS force a* and b* to
 260 be the *same*, so we can't make them into skolem constants that don't unify
 261 with each other.  Alas.
 262
 263 One solution would be insist that in the above defn the programmer uses
 264 the same type variable in both type signatures.  But that takes explanation.
 265
 266 The alternative (currently implemented) is to have a special kind of skolem
 267 constant, SigTv, which can unify with other SigTvs.  These are *not* treated
 268 as rigid for the purposes of GADTs.  And they are used *only* for pattern
 269 bindings and mutually recursive function bindings.  See the function
 270 TcBinds.tcInstSig, and its use_skols parameter.
 271
 272
 273 \begin{code}
 274 -- A TyVarDetails is inside a TyVar
 275 data TcTyVarDetails
 276   = SkolemTv      -- A skolem
 277        Bool       -- True <=> this skolem type variable can be overlapped
 278                   --          when looking up instances
 279                   -- See Note [Binding when looking up instances] in InstEnv
 280
 281   | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi
 282                   -- interactive context
 283
 284   | FlatSkol TcType
 285            -- The "skolem" obtained by flattening during
 286            -- constraint simplification
 287
 288            -- In comments we will use the notation alpha[flat = ty]
 289            -- to represent a flattening skolem variable alpha
 290            -- identified with type ty.
 291
 292   | MetaTv MetaInfo (IORef MetaDetails)
 293
 294 vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
 295 -- See Note [Binding when looking up instances] in InstEnv
 296 vanillaSkolemTv = SkolemTv False  -- Might be instantiated
 297 superSkolemTv   = SkolemTv True   -- Treat this as a completely distinct type
 298
 299 data MetaDetails
 300   = Flexi  -- Flexi type variables unify to become Indirects
 301   | Indirect TcType
 302
 303 instance Outputable MetaDetails where
 304   ppr Flexi         = ptext (sLit "Flexi")
 305   ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
 306
 307 data MetaInfo
 308    = TauTv         -- This MetaTv is an ordinary unification variable
 309                    -- A TauTv is always filled in with a tau-type, which
 310                    -- never contains any ForAlls
 311
 312    | SigTv         -- A variant of TauTv, except that it should not be
 313                    -- unified with a type, only with a type variable
 314                    -- SigTvs are only distinguished to improve error messages
 315                    --      see Note [Signature skolems]
 316                    --      The MetaDetails, if filled in, will
 317                    --      always be another SigTv or a SkolemTv
 318
 319    | TcsTv         -- A MetaTv allocated by the constraint solver
 320                    -- Its particular property is that it is always "touchable"
 321                    -- Nevertheless, the constraint solver has to try to guess
 322                    -- what type to instantiate it to
 323
 324 -------------------------------------
 325 -- UserTypeCtxt describes the origin of the polymorphic type
 326 -- in the places where we need to an expression has that type
 327
 328 data UserTypeCtxt
 329   = FunSigCtxt Name     -- Function type signature
 330                         -- Also used for types in SPECIALISE pragmas
 331   | ExprSigCtxt         -- Expression type signature
 332   | ConArgCtxt Name     -- Data constructor argument
 333   | TySynCtxt Name      -- RHS of a type synonym decl
 334   | GenPatCtxt          -- Pattern in generic decl
 335                         --      f{| a+b |} (Inl x) = ...
 336   | LamPatSigCtxt               -- Type sig in lambda pattern
 337                         --      f (x::t) = ...
 338   | BindPatSigCtxt      -- Type sig in pattern binding pattern
 339                         --      (x::t, y) = e
 340   | ResSigCtxt          -- Result type sig
 341                         --      f x :: t = ....
 342   | ForSigCtxt Name     -- Foreign inport or export signature
 343   | DefaultDeclCtxt     -- Types in a default declaration
 344   | SpecInstCtxt        -- SPECIALISE instance pragma
 345   | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]
 346
 347   | GenSigCtxt          -- Higher-rank or impredicative situations
 348                         -- e.g. (f e) where f has a higher-rank type
 349                         -- We might want to elaborate this
 350
 351 -- Notes re TySynCtxt
 352 -- We allow type synonyms that aren't types; e.g.  type List = []
 353 --
 354 -- If the RHS mentions tyvars that aren't in scope, we'll
 355 -- quantify over them:
 356 --      e.g.    type T = a->a
 357 -- will become  type T = forall a. a->a
 358 --
 359 -- With gla-exts that's right, but for H98 we should complain.
 360
 361 ---------------------------------
 362 -- Kind variables:
 363
 364 mkKindName :: Unique -> Name
 365 mkKindName unique = mkSystemName unique kind_var_occ
 366
 367 kindVarRef :: KindVar -> IORef MetaDetails
 368 kindVarRef tc =
 369   ASSERT ( isTcTyVar tc )
 370   case tcTyVarDetails tc of
 371     MetaTv TauTv ref -> ref
 372     _                -> pprPanic "kindVarRef" (ppr tc)
 373
 374 mkKindVar :: Unique -> IORef MetaDetails -> KindVar
 375 mkKindVar u r
 376   = mkTcTyVar (mkKindName u)
 377               tySuperKind  -- not sure this is right,
 378                             -- do we need kind vars for
 379                             -- coercions?
 380               (MetaTv TauTv r)
 381
 382 kind_var_occ :: OccName -- Just one for all KindVars
 383                         -- They may be jiggled by tidying
 384 kind_var_occ = mkOccName tvName "k"
 385 \end{code}
 386
 387 %************************************************************************
 388 %*                                                                      *
 389                 Pretty-printing
 390 %*                                                                      *
 391 %************************************************************************
 392
 393 \begin{code}
 394 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
 395 -- For debugging
 396 pprTcTyVarDetails (SkolemTv {})     = ptext (sLit "sk")
 397 pprTcTyVarDetails (RuntimeUnk {})  = ptext (sLit "rt")
 398 pprTcTyVarDetails (FlatSkol {})    = ptext (sLit "fsk")
 399 pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
 400 pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
 401 pprTcTyVarDetails (MetaTv SigTv _) = ptext (sLit "sig")
 402
 403 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
 404 pprUserTypeCtxt (FunSigCtxt n)  = ptext (sLit "the type signature for") <+> quotes (ppr n)
 405 pprUserTypeCtxt ExprSigCtxt     = ptext (sLit "an expression type signature")
 406 pprUserTypeCtxt (ConArgCtxt c)  = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
 407 pprUserTypeCtxt (TySynCtxt c)   = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
 408 pprUserTypeCtxt GenPatCtxt      = ptext (sLit "the type pattern of a generic definition")
 409 pprUserTypeCtxt ThBrackCtxt     = ptext (sLit "a Template Haskell quotation [t|...|]")
 410 pprUserTypeCtxt LamPatSigCtxt   = ptext (sLit "a pattern type signature")
 411 pprUserTypeCtxt BindPatSigCtxt  = ptext (sLit "a pattern type signature")
 412 pprUserTypeCtxt ResSigCtxt      = ptext (sLit "a result type signature")
 413 pprUserTypeCtxt (ForSigCtxt n)  = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
 414 pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
 415 pprUserTypeCtxt SpecInstCtxt    = ptext (sLit "a SPECIALISE instance pragma")
 416 pprUserTypeCtxt GenSigCtxt      = ptext (sLit "a type expected by the context")
 417 \end{code}
 418
 419
 420 %************************************************************************
 421 %*                                                                      *
 422 \subsection{TidyType}
 423 %*                                                                      *
 424 %************************************************************************
 425
 426 \begin{code}
 427 -- | This tidies up a type for printing in an error message, or in
 428 -- an interface file.
 429 --
 430 -- It doesn't change the uniques at all, just the print names.
 431 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 432 tidyTyVarBndr (tidy_env, subst) tyvar
 433   = case tidyOccName tidy_env occ1 of
 434       (tidy', occ') -> ((tidy', subst'), tyvar')
 435         where
 436           subst' = extendVarEnv subst tyvar tyvar'
 437           tyvar' = setTyVarName tyvar name'
 438           name'  = tidyNameOcc name occ'
 439   where
 440     name = tyVarName tyvar
 441     occ  = getOccName name
 442     -- System Names are for unification variables;
 443     -- when we tidy them we give them a trailing "0" (or 1 etc)
 444     -- so that they don't take precedence for the un-modified name
 445     occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
 446          | otherwise         = occ
 447
 448
 449 ---------------
 450 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
 451 -- ^ Add the free 'TyVar's to the env in tidy form,
 452 -- so that we can tidy the type they are free in
 453 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
 454
 455 ---------------
 456 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
 457 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
 458
 459 ---------------
 460 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
 461 -- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
 462 -- using the environment if one has not already been allocated. See
 463 -- also 'tidyTyVarBndr'
 464 tidyOpenTyVar env@(_, subst) tyvar
 465   = case lookupVarEnv subst tyvar of
 466         Just tyvar' -> (env, tyvar')            -- Already substituted
 467         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
 468
 469 ---------------
 470 tidyType :: TidyEnv -> Type -> Type
 471 tidyType env@(_, subst) ty
 472   = go ty
 473   where
 474     go (TyVarTy tv)         = case lookupVarEnv subst tv of
 475                                 Nothing  -> expand tv
 476                                 Just tv' -> expand tv'
 477     go (TyConApp tycon tys) = let args = map go tys
 478                               in args `seqList` TyConApp tycon args
 479     go (PredTy sty)         = PredTy (tidyPred env sty)
 480     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
 481     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
 482     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
 483                               where
 484                                 (envp, tvp) = tidyTyVarBndr env tv
 485
 486     -- Expand FlatSkols, the skolems introduced by flattening process
 487     -- We don't want to show them in type error messages
 488     expand tv | isTcTyVar tv
 489               , FlatSkol ty <- tcTyVarDetails tv
 490               = go ty
 491               | otherwise
 492               = TyVarTy tv
 493
 494 ---------------
 495 tidyTypes :: TidyEnv -> [Type] -> [Type]
 496 tidyTypes env tys = map (tidyType env) tys
 497
 498 ---------------
 499 tidyPred :: TidyEnv -> PredType -> PredType
 500 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
 501 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
 502 tidyPred env (EqPred ty1 ty2)  = EqPred (tidyType env ty1) (tidyType env ty2)
 503
 504 ---------------
 505 -- | Grabs the free type variables, tidies them
 506 -- and then uses 'tidyType' to work over the type itself
 507 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
 508 tidyOpenType env ty
 509   = (env', tidyType env' ty)
 510   where
 511     env' = tidyFreeTyVars env (tyVarsOfType ty)
 512
 513 ---------------
 514 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
 515 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
 516
 517 ---------------
 518 -- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
 519 tidyTopType :: Type -> Type
 520 tidyTopType ty = tidyType emptyTidyEnv ty
 521
 522 ---------------
 523 tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
 524 tidyKind env k = tidyOpenType env k
 525 \end{code}
 526
 527 %************************************************************************
 528 %*                                                                      *
 529                             Tidying coercions
 530 %*                                                                      *
 531 %************************************************************************
 532
 533 \begin{code}
 534
 535 tidyCo :: TidyEnv -> Coercion -> Coercion
 536 tidyCo env@(_, subst) co
 537   = go co
 538   where
 539     go (Refl ty)             = Refl (tidyType env ty)
 540     go (TyConAppCo tc cos)   = let args = map go cos
 541                                in args `seqList` TyConAppCo tc args
 542     go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2
 543     go (ForAllCo tv co)      = ForAllCo tvp $! (tidyCo envp co)
 544                                where
 545                                  (envp, tvp) = tidyTyVarBndr env tv
 546     go (CoVarCo cv)          = case lookupVarEnv subst cv of
 547                                  Nothing  -> CoVarCo cv
 548                                  Just cv' -> CoVarCo cv'
 549     go (AxiomInstCo con cos) = let args = tidyCos env cos
 550                                in  args `seqList` AxiomInstCo con args
 551     go (UnsafeCo ty1 ty2)    = (UnsafeCo $! tidyType env ty1) $! tidyType env ty2
 552     go (SymCo co)            = SymCo $! go co
 553     go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2
 554     go (NthCo d co)          = NthCo d $! go co
 555     go (InstCo co ty)        = (InstCo $! go co) $! tidyType env ty
 556
 557 tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
 558 tidyCos env = map (tidyCo env)
 559
 560 \end{code}
 561
 562 %************************************************************************
 563 %*                                                                      *
 564                 Predicates
 565 %*                                                                      *
 566 %************************************************************************
 567
 568 \begin{code}
 569 isImmutableTyVar :: TyVar -> Bool
 570
 571 isImmutableTyVar tv
 572   | isTcTyVar tv = isSkolemTyVar tv
 573   | otherwise    = True
 574
 575 isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
 576   isMetaTyVar :: TcTyVar -> Bool
 577
 578 isTyConableTyVar tv
 579         -- True of a meta-type variable that can be filled in
 580         -- with a type constructor application; in particular,
 581         -- not a SigTv
 582   = ASSERT( isTcTyVar tv)
 583     case tcTyVarDetails tv of
 584         MetaTv SigTv _ -> False
 585         _              -> True
 586
 587 isSkolemTyVar tv
 588   = ASSERT2( isTcTyVar tv, ppr tv )
 589     case tcTyVarDetails tv of
 590         SkolemTv {}   -> True
 591         FlatSkol {}   -> True
 592         RuntimeUnk {} -> True
 593         MetaTv {}     -> False
 594
 595 isOverlappableTyVar tv
 596   = ASSERT( isTcTyVar tv )
 597     case tcTyVarDetails tv of
 598         SkolemTv overlappable -> overlappable
 599         _                     -> False
 600
 601 isMetaTyVar tv
 602   = ASSERT2( isTcTyVar tv, ppr tv )
 603     case tcTyVarDetails tv of
 604         MetaTv _ _ -> True
 605         _          -> False
 606
 607 isMetaTyVarTy :: TcType -> Bool
 608 isMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv
 609 isMetaTyVarTy _            = False
 610
 611 isSigTyVar :: Var -> Bool
 612 isSigTyVar tv
 613   = ASSERT( isTcTyVar tv )
 614     case tcTyVarDetails tv of
 615         MetaTv SigTv _ -> True
 616         _              -> False
 617
 618 metaTvRef :: TyVar -> IORef MetaDetails
 619 metaTvRef tv
 620   = ASSERT2( isTcTyVar tv, ppr tv )
 621     case tcTyVarDetails tv of
 622         MetaTv _ ref -> ref
 623         _          -> pprPanic "metaTvRef" (ppr tv)
 624
 625 isFlexi, isIndirect :: MetaDetails -> Bool
 626 isFlexi Flexi = True
 627 isFlexi _     = False
 628
 629 isIndirect (Indirect _) = True
 630 isIndirect _            = False
 631
 632 isRuntimeUnkSkol :: TyVar -> Bool
 633 -- Called only in TcErrors; see Note [Runtime skolems] there
 634 isRuntimeUnkSkol x
 635   | isTcTyVar x, RuntimeUnk <- tcTyVarDetails x = True
 636   | otherwise                                   = False
 637 \end{code}
 638
 639
 640 %************************************************************************
 641 %*                                                                      *
 642 \subsection{Tau, sigma and rho}
 643 %*                                                                      *
 644 %************************************************************************
 645
 646 \begin{code}
 647 mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
 648 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
 649
 650 mkPhiTy :: [PredType] -> Type -> Type
 651 mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
 652 \end{code}
 653
 654 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
 655
 656 \begin{code}
 657 isTauTy :: Type -> Bool
 658 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
 659 isTauTy (TyVarTy _)       = True
 660 isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
 661 isTauTy (AppTy a b)       = isTauTy a && isTauTy b
 662 isTauTy (FunTy a b)       = isTauTy a && isTauTy b
 663 isTauTy (PredTy _)        = True                -- Don't look through source types
 664 isTauTy _                 = False
 665
 666 isTauTyCon :: TyCon -> Bool
 667 -- Returns False for type synonyms whose expansion is a polytype
 668 isTauTyCon tc
 669   | isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
 670   | otherwise           = True
 671
 672 ---------------
 673 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
 674                                 -- construct a dictionary function name
 675 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
 676 getDFunTyKey (TyVarTy tv)    = getOccName tv
 677 getDFunTyKey (TyConApp tc _) = getOccName tc
 678 getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
 679 getDFunTyKey (FunTy _ _)     = getOccName funTyCon
 680 getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
 681 getDFunTyKey ty              = pprPanic "getDFunTyKey" (pprType ty)
 682 -- PredTy shouldn't happen
 683 \end{code}
 684
 685
 686 %************************************************************************
 687 %*                                                                      *
 688 \subsection{Expanding and splitting}
 689 %*                                                                      *
 690 %************************************************************************
 691
 692 These tcSplit functions are like their non-Tc analogues, but
 693         a) they do not look through newtypes
 694         b) they do not look through PredTys
 695
 696 However, they are non-monadic and do not follow through mutable type
 697 variables.  It's up to you to make sure this doesn't matter.
 698
 699 \begin{code}
 700 tcSplitForAllTys :: Type -> ([TyVar], Type)
 701 tcSplitForAllTys ty = split ty ty []
 702    where
 703      split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
 704      split _ (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
 705      split orig_ty _          tvs = (reverse tvs, orig_ty)
 706
 707 tcIsForAllTy :: Type -> Bool
 708 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
 709 tcIsForAllTy (ForAllTy {}) = True
 710 tcIsForAllTy _             = False
 711
 712 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
 713 -- Split off the first predicate argument from a type
 714 tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
 715 tcSplitPredFunTy_maybe (FunTy arg res)
 716   | Just p <- splitPredTy_maybe arg = Just (p, res)
 717 tcSplitPredFunTy_maybe _
 718   = Nothing
 719
 720 tcSplitPhiTy :: Type -> (ThetaType, Type)
 721 tcSplitPhiTy ty
 722   = split ty []
 723   where
 724     split ty ts
 725       = case tcSplitPredFunTy_maybe ty of
 726           Just (pred, ty) -> split ty (pred:ts)
 727           Nothing         -> (reverse ts, ty)
 728
 729 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
 730 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
 731                         (tvs, rho) -> case tcSplitPhiTy rho of
 732                                         (theta, tau) -> (tvs, theta, tau)
 733
 734 -----------------------
 735 tcDeepSplitSigmaTy_maybe
 736   :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)
 737 -- Looks for a *non-trivial* quantified type, under zero or more function arrows
 738 -- By "non-trivial" we mean either tyvars or constraints are non-empty
 739
 740 tcDeepSplitSigmaTy_maybe ty
 741   | Just (arg_ty, res_ty)           <- tcSplitFunTy_maybe ty
 742   , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty
 743   = Just (arg_ty:arg_tys, tvs, theta, rho)
 744
 745   | (tvs, theta, rho) <- tcSplitSigmaTy ty
 746   , not (null tvs && null theta)
 747   = Just ([], tvs, theta, rho)
 748
 749   | otherwise = Nothing
 750
 751 -----------------------
 752 tcTyConAppTyCon :: Type -> TyCon
 753 tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
 754                         Just (tc, _) -> tc
 755                         Nothing      -> pprPanic "tcTyConAppTyCon" (pprType ty)
 756
 757 tcTyConAppArgs :: Type -> [Type]
 758 tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
 759                         Just (_, args) -> args
 760                         Nothing        -> pprPanic "tcTyConAppArgs" (pprType ty)
 761
 762 tcSplitTyConApp :: Type -> (TyCon, [Type])
 763 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
 764                         Just stuff -> stuff
 765                         Nothing    -> pprPanic "tcSplitTyConApp" (pprType ty)
 766
 767 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
 768 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
 769 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
 770 tcSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
 771         -- Newtypes are opaque, so they may be split
 772         -- However, predicates are not treated
 773         -- as tycon applications by the type checker
 774 tcSplitTyConApp_maybe _                 = Nothing
 775
 776 -----------------------
 777 tcSplitFunTys :: Type -> ([Type], Type)
 778 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
 779                         Nothing        -> ([], ty)
 780                         Just (arg,res) -> (arg:args, res')
 781                                        where
 782                                           (args,res') = tcSplitFunTys res
 783
 784 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
 785 tcSplitFunTy_maybe ty | Just ty' <- tcView ty           = tcSplitFunTy_maybe ty'
 786 tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
 787 tcSplitFunTy_maybe _                                    = Nothing
 788         -- Note the (not (isPredTy arg)) guard
 789         -- Consider     (?x::Int) => Bool
 790         -- We don't want to treat this as a function type!
 791         -- A concrete example is test tc230:
 792         --      f :: () -> (?p :: ()) => () -> ()
 793         --
 794         --      g = f () ()
 795
 796 tcSplitFunTysN
 797         :: TcRhoType
 798         -> Arity                -- N: Number of desired args
 799         -> ([TcSigmaType],      -- Arg types (N or fewer)
 800             TcSigmaType)        -- The rest of the type
 801
 802 tcSplitFunTysN ty n_args
 803   | n_args == 0
 804   = ([], ty)
 805   | Just (arg,res) <- tcSplitFunTy_maybe ty
 806   = case tcSplitFunTysN res (n_args - 1) of
 807         (args, res) -> (arg:args, res)
 808   | otherwise
 809   = ([], ty)
 810
 811 tcSplitFunTy :: Type -> (Type, Type)
 812 tcSplitFunTy  ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
 813
 814 tcFunArgTy :: Type -> Type
 815 tcFunArgTy    ty = fst (tcSplitFunTy ty)
 816
 817 tcFunResultTy :: Type -> Type
 818 tcFunResultTy ty = snd (tcSplitFunTy ty)
 819
 820 -----------------------
 821 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
 822 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
 823 tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
 824
 825 tcSplitAppTy :: Type -> (Type, Type)
 826 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
 827                     Just stuff -> stuff
 828                     Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)
 829
 830 tcSplitAppTys :: Type -> (Type, [Type])
 831 tcSplitAppTys ty
 832   = go ty []
 833   where
 834     go ty args = case tcSplitAppTy_maybe ty of
 835                    Just (ty', arg) -> go ty' (arg:args)
 836                    Nothing         -> (ty,args)
 837
 838 -----------------------
 839 tcGetTyVar_maybe :: Type -> Maybe TyVar
 840 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
 841 tcGetTyVar_maybe (TyVarTy tv)   = Just tv
 842 tcGetTyVar_maybe _              = Nothing
 843
 844 tcGetTyVar :: String -> Type -> TyVar
 845 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
 846
 847 tcIsTyVarTy :: Type -> Bool
 848 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
 849
 850 -----------------------
 851 tcSplitDFunTy :: Type -> ([TyVar], Int, Class, [Type])
 852 -- Split the type of a dictionary function
 853 -- We don't use tcSplitSigmaTy,  because a DFun may (with NDP)
 854 -- have non-Pred arguments, such as
 855 --     df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
 856 tcSplitDFunTy ty
 857   = case tcSplitForAllTys ty   of { (tvs, rho)  ->
 858     case split_dfun_args 0 rho of { (n_theta, tau) ->
 859     case tcSplitDFunHead tau   of { (clas, tys) ->
 860     (tvs, n_theta, clas, tys) }}}
 861   where
 862     -- Count the context of the dfun.  This can be a mix of
 863     -- coercion and class constraints; or (in the general NDP case)
 864     -- some other function argument
 865     split_dfun_args n ty | Just ty' <- tcView ty = split_dfun_args n ty'
 866     split_dfun_args n (FunTy _ ty)     = split_dfun_args (n+1) ty
 867     split_dfun_args n ty               = (n, ty)
 868
 869 tcSplitDFunHead :: Type -> (Class, [Type])
 870 tcSplitDFunHead tau
 871   = case splitPredTy_maybe tau of
 872         Just (ClassP clas tys) -> (clas, tys)
 873         _ -> pprPanic "tcSplitDFunHead" (ppr tau)
 874
 875 tcInstHeadTyNotSynonym :: Type -> Bool
 876 -- Used in Haskell-98 mode, for the argument types of an instance head
 877 -- These must not be type synonyms, but everywhere else type synonyms
 878 -- are transparent, so we need a special function here
 879 tcInstHeadTyNotSynonym ty
 880   = case ty of
 881         TyConApp tc _ -> not (isSynTyCon tc)
 882         _ -> True
 883
 884 tcInstHeadTyAppAllTyVars :: Type -> Bool
 885 -- Used in Haskell-98 mode, for the argument types of an instance head
 886 -- These must be a constructor applied to type variable arguments
 887 tcInstHeadTyAppAllTyVars ty
 888   | Just ty' <- tcView ty       -- Look through synonyms
 889   = tcInstHeadTyAppAllTyVars ty'
 890   | otherwise
 891   = case ty of
 892         TyConApp _ tys  -> ok tys
 893         FunTy arg res   -> ok [arg, res]
 894         _               -> False
 895   where
 896         -- Check that all the types are type variables,
 897         -- and that each is distinct
 898     ok tys = equalLength tvs tys && hasNoDups tvs
 899            where
 900              tvs = mapCatMaybes get_tv tys
 901
 902     get_tv (TyVarTy tv)  = Just tv      -- through synonyms
 903     get_tv _             = Nothing
 904 \end{code}
 905
 906
 907
 908 %************************************************************************
 909 %*                                                                      *
 910 \subsection{Predicate types}
 911 %*                                                                      *
 912 %************************************************************************
 913
 914 Superclasses
 915
 916 \begin{code}
 917 mkMinimalBySCs :: [PredType] -> [PredType]
 918 -- Remove predicates that can be deduced from others by superclasses
 919 mkMinimalBySCs ptys = [ ploc |  ploc <- ptys
 920                              ,  ploc `not_in_preds` rec_scs ]
 921  where
 922    rec_scs = concatMap trans_super_classes ptys
 923    not_in_preds p ps = null (filter (eqPred p) ps)
 924    trans_super_classes (ClassP cls tys) = transSuperClasses cls tys
 925    trans_super_classes _other_pty       = []
 926
 927 transSuperClasses :: Class -> [Type] -> [PredType]
 928 transSuperClasses cls tys
 929   = foldl (\pts p -> trans_sc p ++ pts) [] $
 930     immSuperClasses cls tys
 931   where trans_sc :: PredType -> [PredType]
 932         trans_sc this_pty@(ClassP cls tys)
 933           = foldl (\pts p -> trans_sc p ++ pts) [this_pty] $
 934             immSuperClasses cls tys
 935         trans_sc pty = [pty]
 936
 937 immSuperClasses :: Class -> [Type] -> [PredType]
 938 immSuperClasses cls tys
 939   = substTheta (zipTopTvSubst tyvars tys) sc_theta
 940   where (tyvars,sc_theta,_,_) = classBigSig cls
 941 \end{code}
 942
 943
 944 %************************************************************************
 945 %*                                                                      *
 946 \subsection{Predicates}
 947 %*                                                                      *
 948 %************************************************************************
 949
 950 isSigmaTy returns true of any qualified type.  It doesn't *necessarily* have
 951 any foralls.  E.g.
 952         f :: (?x::Int) => Int -> Int
 953
 954 \begin{code}
 955 isSigmaTy :: Type -> Bool
 956 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
 957 isSigmaTy (ForAllTy _ _) = True
 958 isSigmaTy (FunTy a _)    = isPredTy a
 959 isSigmaTy _              = False
 960
 961 isOverloadedTy :: Type -> Bool
 962 -- Yes for a type of a function that might require evidence-passing
 963 -- Used only by bindLocalMethods
 964 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
 965 isOverloadedTy (ForAllTy _ ty) = isOverloadedTy ty
 966 isOverloadedTy (FunTy a _)     = isPredTy a
 967 isOverloadedTy _               = False
 968 \end{code}
 969
 970 \begin{code}
 971 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
 972     isUnitTy, isCharTy :: Type -> Bool
 973 isFloatTy      = is_tc floatTyConKey
 974 isDoubleTy     = is_tc doubleTyConKey
 975 isIntegerTy    = is_tc integerTyConKey
 976 isIntTy        = is_tc intTyConKey
 977 isWordTy       = is_tc wordTyConKey
 978 isBoolTy       = is_tc boolTyConKey
 979 isUnitTy       = is_tc unitTyConKey
 980 isCharTy       = is_tc charTyConKey
 981
 982 isStringTy :: Type -> Bool
 983 isStringTy ty
 984   = case tcSplitTyConApp_maybe ty of
 985       Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
 986       _                   -> False
 987
 988 is_tc :: Unique -> Type -> Bool
 989 -- Newtypes are opaque to this
 990 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
 991                         Just (tc, _) -> uniq == getUnique tc
 992                         Nothing      -> False
 993 \end{code}
 994
 995 \begin{code}
 996 -- NB: Currently used in places where we have already expanded type synonyms;
 997 --     hence no 'coreView'.  This could, however, be changed without breaking
 998 --     any code.
 999 isSynFamilyTyConApp :: TcTauType -> Bool
1000 isSynFamilyTyConApp (TyConApp tc tys) = isSynFamilyTyCon tc &&
1001                                       length tys == tyConArity tc
1002 isSynFamilyTyConApp _other            = False
1003 \end{code}
1004
1005
1006 %************************************************************************
1007 %*                                                                      *
1008 \subsection{Misc}
1009 %*                                                                      *
1010 %************************************************************************
1011
1012 \begin{code}
1013 deNoteType :: Type -> Type
1014 -- Remove all *outermost* type synonyms and other notes
1015 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
1016 deNoteType ty = ty
1017 \end{code}
1018
1019 \begin{code}
1020 tcTyVarsOfType :: Type -> TcTyVarSet
1021 -- Just the *TcTyVars* free in the type
1022 -- (Types.tyVarsOfTypes finds all free TyVars)
1023 tcTyVarsOfType (TyVarTy tv)         = if isTcTyVar tv then unitVarSet tv
1024                                                       else emptyVarSet
1025 tcTyVarsOfType (TyConApp _ tys)     = tcTyVarsOfTypes tys
1026 tcTyVarsOfType (PredTy sty)         = tcTyVarsOfPred sty
1027 tcTyVarsOfType (FunTy arg res)      = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
1028 tcTyVarsOfType (AppTy fun arg)      = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
1029 tcTyVarsOfType (ForAllTy tyvar ty)  = tcTyVarsOfType ty `delVarSet` tyvar
1030         -- We do sometimes quantify over skolem TcTyVars
1031
1032 tcTyVarsOfTypes :: [Type] -> TyVarSet
1033 tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
1034
1035 tcTyVarsOfPred :: PredType -> TyVarSet
1036 tcTyVarsOfPred (IParam _ ty)    = tcTyVarsOfType ty
1037 tcTyVarsOfPred (ClassP _ tys)   = tcTyVarsOfTypes tys
1038 tcTyVarsOfPred (EqPred ty1 ty2) = tcTyVarsOfType ty1 `unionVarSet` tcTyVarsOfType ty2
1039 \end{code}
1040
1041 Find the free tycons and classes of a type.  This is used in the front
1042 end of the compiler.
1043
1044 \begin{code}
1045 orphNamesOfType :: Type -> NameSet
1046 orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
1047                 -- Look through type synonyms (Trac #4912)
1048 orphNamesOfType (TyVarTy _)                = emptyNameSet
1049 orphNamesOfType (TyConApp tycon tys)       = unitNameSet (getName tycon)
1050                                              `unionNameSets` orphNamesOfTypes tys
1051 orphNamesOfType (PredTy (IParam _ ty))    = orphNamesOfType ty
1052 orphNamesOfType (PredTy (ClassP cl tys))  = unitNameSet (getName cl)
1053                                             `unionNameSets` orphNamesOfTypes tys
1054 orphNamesOfType (PredTy (EqPred ty1 ty2)) = orphNamesOfType ty1
1055                                             `unionNameSets` orphNamesOfType ty2
1056 orphNamesOfType (FunTy arg res)     = orphNamesOfType arg `unionNameSets` orphNamesOfType res
1057 orphNamesOfType (AppTy fun arg)     = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
1058 orphNamesOfType (ForAllTy _ ty)     = orphNamesOfType ty
1059
1060 orphNamesOfTypes :: [Type] -> NameSet
1061 orphNamesOfTypes tys = foldr (unionNameSets . orphNamesOfType) emptyNameSet tys
1062
1063 orphNamesOfDFunHead :: Type -> NameSet
1064 -- Find the free type constructors and classes
1065 -- of the head of the dfun instance type
1066 -- The 'dfun_head_type' is because of
1067 --      instance Foo a => Baz T where ...
1068 -- The decl is an orphan if Baz and T are both not locally defined,
1069 --      even if Foo *is* locally defined
1070 orphNamesOfDFunHead dfun_ty
1071   = case tcSplitSigmaTy dfun_ty of
1072         (_, _, head_ty) -> orphNamesOfType head_ty
1073
1074 orphNamesOfCo :: Coercion -> NameSet
1075 orphNamesOfCo (Refl ty)             = orphNamesOfType ty
1076 orphNamesOfCo (TyConAppCo tc cos)   = unitNameSet (getName tc) `unionNameSets` orphNamesOfCos cos
1077 orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1078 orphNamesOfCo (ForAllCo _ co)       = orphNamesOfCo co
1079 orphNamesOfCo (CoVarCo _)           = emptyNameSet
1080 orphNamesOfCo (AxiomInstCo con cos) = orphNamesOfCoCon con `unionNameSets` orphNamesOfCos cos
1081 orphNamesOfCo (UnsafeCo ty1 ty2)    = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
1082 orphNamesOfCo (SymCo co)            = orphNamesOfCo co
1083 orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1084 orphNamesOfCo (NthCo _ co)          = orphNamesOfCo co
1085 orphNamesOfCo (InstCo co ty)        = orphNamesOfCo co `unionNameSets` orphNamesOfType ty
1086
1087 orphNamesOfCos :: [Coercion] -> NameSet
1088 orphNamesOfCos = foldr (unionNameSets . orphNamesOfCo) emptyNameSet
1089
1090 orphNamesOfCoCon :: CoAxiom -> NameSet
1091 orphNamesOfCoCon (CoAxiom { co_ax_lhs = ty1, co_ax_rhs = ty2 })
1092   = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
1093 \end{code}
1094
1095
1096 %************************************************************************
1097 %*                                                                      *
1098 \subsection[TysWiredIn-ext-type]{External types}
1099 %*                                                                      *
1100 %************************************************************************
1101
1102 The compiler's foreign function interface supports the passing of a
1103 restricted set of types as arguments and results (the restricting factor
1104 being the )
1105
1106 \begin{code}
1107 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, Coercion)
1108 -- (isIOType t) returns Just (IO,t',co)
1109 --                              if co : t ~ IO t'
1110 --              returns Nothing otherwise
1111 tcSplitIOType_maybe ty
1112   = case tcSplitTyConApp_maybe ty of
1113         -- This split absolutely has to be a tcSplit, because we must
1114         -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
1115
1116         Just (io_tycon, [io_res_ty])
1117            |  io_tycon `hasKey` ioTyConKey
1118            -> Just (io_tycon, io_res_ty, mkReflCo ty)
1119
1120         Just (tc, tys)
1121            | not (isRecursiveTyCon tc)
1122            , Just (ty, co1) <- instNewTyCon_maybe tc tys
1123                   -- Newtypes that require a coercion are ok
1124            -> case tcSplitIOType_maybe ty of
1125                 Nothing             -> Nothing
1126                 Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCo` co2)
1127
1128         _ -> Nothing
1129
1130 isFFITy :: Type -> Bool
1131 -- True for any TyCon that can possibly be an arg or result of an FFI call
1132 isFFITy ty = checkRepTyCon legalFFITyCon ty
1133
1134 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1135 -- Checks for valid argument type for a 'foreign import'
1136 isFFIArgumentTy dflags safety ty
1137    = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1138
1139 isFFIExternalTy :: Type -> Bool
1140 -- Types that are allowed as arguments of a 'foreign export'
1141 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1142
1143 isFFIImportResultTy :: DynFlags -> Type -> Bool
1144 isFFIImportResultTy dflags ty
1145   = checkRepTyCon (legalFIResultTyCon dflags) ty
1146
1147 isFFIExportResultTy :: Type -> Bool
1148 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1149
1150 isFFIDynArgumentTy :: Type -> Bool
1151 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
1152 -- or a newtype of either.
1153 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1154
1155 isFFIDynResultTy :: Type -> Bool
1156 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
1157 -- or a newtype of either.
1158 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1159
1160 isFFILabelTy :: Type -> Bool
1161 -- The type of a foreign label must be Ptr, FunPtr, Addr,
1162 -- or a newtype of either.
1163 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1164
1165 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1166 -- Checks for valid argument type for a 'foreign import prim'
1167 -- Currently they must all be simple unlifted types.
1168 isFFIPrimArgumentTy dflags ty
1169    = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1170
1171 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1172 -- Checks for valid result type for a 'foreign import prim'
1173 -- Currently it must be an unlifted type, including unboxed tuples.
1174 isFFIPrimResultTy dflags ty
1175    = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1176
1177 isFFIDotnetTy :: DynFlags -> Type -> Bool
1178 isFFIDotnetTy dflags ty
1179   = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
1180                            isFFIDotnetObjTy ty || isStringTy ty)) ty
1181         -- NB: isStringTy used to look through newtypes, but
1182         --     it no longer does so.  May need to adjust isFFIDotNetTy
1183         --     if we do want to look through newtypes.
1184
1185 isFFIDotnetObjTy :: Type -> Bool
1186 isFFIDotnetObjTy ty
1187   = checkRepTyCon check_tc t_ty
1188   where
1189    (_, t_ty) = tcSplitForAllTys ty
1190    check_tc tc = getName tc == objectTyConName
1191
1192 isFunPtrTy :: Type -> Bool
1193 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1194
1195 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1196 -- Look through newtypes, but *not* foralls
1197 -- Should work even for recursive newtypes
1198 -- eg Manuel had:       newtype T = MkT (Ptr T)
1199 checkRepTyCon check_tc ty
1200   = go [] ty
1201   where
1202     go rec_nts ty
1203       | Just (tc,tys) <- splitTyConApp_maybe ty
1204       = case carefullySplitNewType_maybe rec_nts tc tys of
1205            Just (rec_nts', ty') -> go rec_nts' ty'
1206            Nothing              -> check_tc tc
1207       | otherwise
1208       = False
1209
1210 checkRepTyConKey :: [Unique] -> Type -> Bool
1211 -- Like checkRepTyCon, but just looks at the TyCon key
1212 checkRepTyConKey keys
1213   = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1214 \end{code}
1215
1216 ----------------------------------------------
1217 These chaps do the work; they are not exported
1218 ----------------------------------------------
1219
1220 \begin{code}
1221 legalFEArgTyCon :: TyCon -> Bool
1222 legalFEArgTyCon tc
1223   -- It's illegal to make foreign exports that take unboxed
1224   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
1225   = boxedMarshalableTyCon tc
1226
1227 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1228 legalFIResultTyCon dflags tc
1229   | tc == unitTyCon         = True
1230   | otherwise               = marshalableTyCon dflags tc
1231
1232 legalFEResultTyCon :: TyCon -> Bool
1233 legalFEResultTyCon tc
1234   | tc == unitTyCon         = True
1235   | otherwise               = boxedMarshalableTyCon tc
1236
1237 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1238 -- Checks validity of types going from Haskell -> external world
1239 legalOutgoingTyCon dflags _ tc
1240   = marshalableTyCon dflags tc
1241
1242 legalFFITyCon :: TyCon -> Bool
1243 -- True for any TyCon that can possibly be an arg or result of an FFI call
1244 legalFFITyCon tc
1245   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1246
1247 marshalableTyCon :: DynFlags -> TyCon -> Bool
1248 marshalableTyCon dflags tc
1249   =  (xopt Opt_UnliftedFFITypes dflags
1250       && isUnLiftedTyCon tc
1251       && not (isUnboxedTupleTyCon tc)
1252       && case tyConPrimRep tc of        -- Note [Marshalling VoidRep]
1253            VoidRep -> False
1254            _       -> True)
1255   || boxedMarshalableTyCon tc
1256
1257 boxedMarshalableTyCon :: TyCon -> Bool
1258 boxedMarshalableTyCon tc
1259    = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1260                          , int32TyConKey, int64TyConKey
1261                          , wordTyConKey, word8TyConKey, word16TyConKey
1262                          , word32TyConKey, word64TyConKey
1263                          , floatTyConKey, doubleTyConKey
1264                          , ptrTyConKey, funPtrTyConKey
1265                          , charTyConKey
1266                          , stablePtrTyConKey
1267                          , boolTyConKey
1268                          ]
1269
1270 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1271 -- Check args of 'foreign import prim', only allow simple unlifted types.
1272 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1273 -- currently they're of the wrong kind to use in function args anyway.
1274 legalFIPrimArgTyCon dflags tc
1275   = xopt Opt_UnliftedFFITypes dflags
1276     && isUnLiftedTyCon tc
1277     && not (isUnboxedTupleTyCon tc)
1278
1279 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1280 -- Check result type of 'foreign import prim'. Allow simple unlifted
1281 -- types and also unboxed tuple result types '... -> (# , , #)'
1282 legalFIPrimResultTyCon dflags tc
1283   = xopt Opt_UnliftedFFITypes dflags
1284     && isUnLiftedTyCon tc
1285     && (isUnboxedTupleTyCon tc
1286         || case tyConPrimRep tc of      -- Note [Marshalling VoidRep]
1287            VoidRep -> False
1288            _       -> True)
1289 \end{code}
1290
1291 Note [Marshalling VoidRep]
1292 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1293 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1294 In turn that means you can't write
1295         foreign import foo :: Int -> State# RealWorld
1296
1297 Reason: the back end falls over with panic "primRepHint:VoidRep";
1298         and there is no compelling reason to permit it