TcType.lhs 41.7 KB
Newer Older
1

2 3 4 5
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[TcType]{Types used in the typechecker}

6 7
This module provides the Type interface for front-end parts of the 
compiler.  These parts 
8

9 10 11
	* treat "source types" as opaque: 
		newtypes, and predicates are meaningful. 
	* look through usage types
12

13 14
The "tc" prefix is for "typechechecker", because the type checker
is the principal client.
15

16 17
\begin{code}
module TcType (
18
  --------------------------------
19
  -- Types 
20
  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 
21
  TcTyVar, TcTyVarSet, TcKind, 
22

23 24
  BoxyTyVar, BoxySigmaType, BoxyRhoType, BoxyThetaType, BoxyType,

25
  --------------------------------
26
  -- MetaDetails
27 28 29 30 31
  UserTypeCtxt(..), pprUserTypeCtxt,
  TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails,
  MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
  isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, isSigTyVar, isExistentialTyVar, 
  metaTvRef, 
32
  isFlexi, isIndirect, 
33 34

  --------------------------------
35
  -- Builders
36
  mkPhiTy, mkSigmaTy, 
37

38 39 40
  --------------------------------
  -- Splitters  
  -- These are important because they do not look through newtypes
41
  tcView,
42
  tcSplitForAllTys, tcSplitPhiTy, 
43
  tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
44
  tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
45
  tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, 
46
  tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
47
  tcSplitSigmaTy, tcMultiSplitSigmaTy, 
48 49 50 51

  ---------------------------------
  -- Predicates. 
  -- Again, newtypes are opaque
52
  tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
53
  isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
54
  isDoubleTy, isFloatTy, isIntTy, isStringTy,
55
  isIntegerTy, isBoolTy, isUnitTy,
56
  isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
57 58 59

  ---------------------------------
  -- Misc type manipulators
60
  deNoteType, classesOfTheta,
61
  tyClsNamesOfType, tyClsNamesOfDFunHead, 
62 63 64 65
  getDFunTyKey,

  ---------------------------------
  -- Predicate types  
66
  getClassPredTys_maybe, getClassPredTys, 
67
  isClassPred, isTyVarClassPred, 
68
  mkDictTy, tcSplitPredTy_maybe, 
69
  isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique, 
70
  mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName, 
71
  dataConsStupidTheta, isRefineableTy,
72

73 74 75 76 77 78 79 80 81
  ---------------------------------
  -- Foreign import and export
  isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
  isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
  isFFIExportResultTy, -- :: Type -> Bool
  isFFIExternalTy,     -- :: Type -> Bool
  isFFIDynArgumentTy,  -- :: Type -> Bool
  isFFIDynResultTy,    -- :: Type -> Bool
  isFFILabelTy,        -- :: Type -> Bool
sof's avatar
sof committed
82 83
  isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
  isFFIDotnetObjTy,    -- :: Type -> Bool
84
  isFFITy,	       -- :: Type -> Bool
85
  tcSplitIOType_maybe, -- :: Type -> Maybe Type  
sof's avatar
sof committed
86
  toDNType,            -- :: Type -> DNType
87

88 89
  --------------------------------
  -- Rexported from Type
90
  Kind, 	-- Stuff to do with kinds is insensitive to pre/post Tc
Simon Marlow's avatar
Simon Marlow committed
91 92
  unliftedTypeKind, liftedTypeKind, unboxedTypeKind,
  openTypeKind, mkArrowKind, mkArrowKinds, 
93
  isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, 
94
  isArgTypeKind, isSubKind, defaultKind, 
95

96
  Type, PredType(..), ThetaType, 
97 98
  mkForAllTy, mkForAllTys, 
  mkFunTy, mkFunTys, zipFunTys, 
99
  mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
100
  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys, 
101

102 103 104
  -- Type substitutions
  TvSubst(..), 	-- Representation visible to a few friends
  TvSubstEnv, emptyTvSubst,
105 106 107
  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
  getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
  extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
108
  substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
109

110 111
  isUnLiftedType,	-- Source types are always lifted
  isUnboxedTupleType,	-- Ditto
112
  isPrimitiveType, 
113

114
  tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
115
  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, tidySkolemTyVar,
116
  typeKind, tidyKind,
117

118
  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
119
  tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
120

121
  pprKind, pprParendKind,
122
  pprType, pprParendType, pprTyThingCategory,
123
  pprPred, pprTheta, pprThetaArrow, pprClassPred
124

125
  ) where
126

127
#include "HsVersions.h"
128

129
-- friends:
130
import TypeRep		( Type(..), funTyCon )  -- friend
131 132

import Type		(	-- Re-exports
133
			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
134
			  tyVarsOfTheta, Kind, PredType(..),
Simon Marlow's avatar
Simon Marlow committed
135
			  ThetaType, unliftedTypeKind, unboxedTypeKind,
136
			  liftedTypeKind, openTypeKind, mkArrowKind,
137
		  	  isLiftedTypeKind, isUnliftedTypeKind, 
138
			  mkArrowKinds, mkForAllTy, mkForAllTys,
139
			  defaultKind, isArgTypeKind, isOpenTypeKind,
140
			  mkFunTy, mkFunTys, zipFunTys, 
141 142
			  mkTyConApp, mkAppTy,
			  mkAppTys, applyTy, applyTys,
143
			  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
144
			  mkPredTys, isUnLiftedType, 
145
			  isUnboxedTupleType, isPrimitiveType,
146
			  splitTyConApp_maybe,
147 148 149
			  tidyTopType, tidyType, tidyPred, tidyTypes,
			  tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
			  tidyTyVarBndr, tidyOpenTyVar,
150
			  tidyOpenTyVars, tidyKind,
151
			  isSubKind, tcView,
152 153 154 155

			  tcEqType, tcEqTypes, tcCmpType, tcCmpTypes, 
			  tcEqPred, tcCmpPred, tcEqTypeX, 

156
			  TvSubst(..),
157
			  TvSubstEnv, emptyTvSubst, mkTvSubst, zipTyEnv,
158
			  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
159
			  getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
160
			  extendTvSubst, extendTvSubstList, isInScope, notElemTvSubst,
161
		  	  substTy, substTys, substTyWith, substTheta, 
162
			  substTyVar, substTyVarBndr, substPred, lookupTyVar,
163

164
			  typeKind, repType, coreView,
165
			  pprKind, pprParendKind,
166
			  pprType, pprParendType, pprTyThingCategory,
167
			  pprPred, pprTheta, pprThetaArrow, pprClassPred
168
			)
169
import TyCon		( TyCon, isUnLiftedTyCon, isSynTyCon, synTyConDefn, tyConUnique )
170
import DataCon		( DataCon, dataConStupidTheta, dataConResTys )
171
import Class		( Class )
172
import Var		( TyVar, Id, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
173
import ForeignCall	( Safety, DNType(..) )
174
import Unify		( tcMatchTys )
175
import VarSet
176 177

-- others:
178
import DynFlags		( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
179
import Name		( Name, NamedThing(..), mkInternalName, getSrcLoc )
180
import NameSet
181
import VarEnv		( TidyEnv )
182
import OccName		( OccName, mkDictOcc )
183
import PrelNames	-- Lots (e.g. in isFFIArgumentTy)
184
import TysWiredIn	( unitTyCon, charTyCon, listTyCon )
185
import BasicTypes	( IPName(..), Arity, ipNameName )
186
import SrcLoc		( SrcLoc, SrcSpan )
187 188 189
import Util		( snocView, equalLength )
import Maybes		( maybeToBool, expectJust, mapCatMaybes )
import ListSetOps	( hasNoDups )
190
import List		( nubBy )
191
import Outputable
192
import DATA_IOREF
193 194 195
\end{code}


196 197
%************************************************************************
%*									*
198 199 200 201
\subsection{Types}
%*									*
%************************************************************************

202 203 204
The type checker divides the generic Type world into the 
following more structured beasts:

205
sigma ::= forall tyvars. phi
206 207 208 209 210 211 212 213 214 215
	-- A sigma type is a qualified type
	--
	-- Note that even if 'tyvars' is empty, theta
	-- may not be: e.g.   (?x::Int) => Int

	-- Note that 'sigma' is in prenex form:
	-- all the foralls are at the front.
	-- A 'phi' type has no foralls to the right of
	-- an arrow

216 217 218
phi :: theta => rho

rho ::= sigma -> rho
219 220 221 222 223 224 225 226 227 228 229 230
     |  tau

-- A 'tau' type has no quantification anywhere
-- Note that the args of a type constructor must be taus
tau ::= tyvar
     |  tycon tau_1 .. tau_n
     |  tau_1 tau_2
     |  tau_1 -> tau_2

-- In all cases, a (saturated) type synonym application is legal,
-- provided it expands to the required form.

231
\begin{code}
232 233
type TcTyVar = TyVar  	-- Used only during type inference
type TcType = Type 	-- A TcType can have mutable type variables
234 235 236 237 238
	-- Invariant on ForAllTy in TcTypes:
	-- 	forall a. T
	-- a cannot occur inside a MutTyVar in T; that is,
	-- T is "flattened" before quantifying over a

239
-- These types do not have boxy type variables in them
240 241
type TcPredType     = PredType
type TcThetaType    = ThetaType
242
type TcSigmaType    = TcType
243
type TcRhoType      = TcType
244
type TcTauType      = TcType
245
type TcKind         = Kind
246
type TcTyVarSet     = TyVarSet
247

248 249 250 251 252 253
-- These types may have boxy type variables in them
type BoxyTyVar	    = TcTyVar
type BoxyRhoType    = TcType	
type BoxyThetaType  = TcThetaType	
type BoxySigmaType  = TcType		
type BoxyType       = TcType		
254 255 256 257 258 259
\end{code}


%************************************************************************
%*									*
\subsection{TyVarDetails}
260 261 262
%*									*
%************************************************************************

263 264
TyVarDetails gives extra info about type variables, used during type
checking.  It's attached to mutable type variables only.
265 266
It's knot-tied back to Var.lhs.  There is no reason in principle
why Var.lhs shouldn't actually have the definition, but it "belongs" here.
267

268

269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286
Note [Signature skolems]
~~~~~~~~~~~~~~~~~~~~~~~~
Consider this

  x :: [a]
  y :: b
  (x,y,z) = ([y,z], z, head x)

Here, x and y have type sigs, which go into the environment.  We used to
instantiate their types with skolem constants, and push those types into
the RHS, so we'd typecheck the RHS with type
	( [a*], b*, c )
where a*, b* are skolem constants, and c is an ordinary meta type varible.

The trouble is that the occurrences of z in the RHS force a* and b* to 
be the *same*, so we can't make them into skolem constants that don't unify
with each other.  Alas.

287
One solution would be insist that in the above defn the programmer uses
288 289 290
the same type variable in both type signatures.  But that takes explanation.

The alternative (currently implemented) is to have a special kind of skolem
291 292 293 294
constant, SigTv, which can unify with other SigTvs.  These are *not* treated
as righd for the purposes of GADTs.  And they are used *only* for pattern 
bindings and mutually recursive function bindings.  See the function
TcBinds.tcInstSig, and its use_skols parameter.
295 296


297
\begin{code}
298 299
-- A TyVarDetails is inside a TyVar
data TcTyVarDetails
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333
  = SkolemTv SkolemInfo			-- A skolem constant

  | MetaTv BoxInfo (IORef MetaDetails)

data BoxInfo 
   = BoxTv	-- The contents is a (non-boxy) sigma-type
		-- That is, this MetaTv is a "box"

   | TauTv	-- The contents is a (non-boxy) tau-type
		-- That is, this MetaTv is an ordinary unification variable

   | SigTv SkolemInfo	-- A variant of TauTv, except that it should not be
			-- unified with a type, only with a type variable
			-- SigTvs are only distinguished to improve error messages
			--      see Note [Signature skolems]        
			--      The MetaDetails, if filled in, will 
			--      always be another SigTv or a SkolemTv

-- INVARIANTS:
--  	A TauTv is always filled in with a tau-type, which
--	never contains any BoxTvs, nor any ForAlls 
--
--	However, a BoxTv can contain a type that contains further BoxTvs
--	Notably, when typechecking an explicit list, say [e1,e2], with
--	expected type being a box b1, we fill in b1 with (List b2), where
--	b2 is another (currently empty) box.

data MetaDetails
  = Flexi          -- Flexi type variables unify to become 
                   -- Indirects.  

  | Indirect TcType  -- INVARIANT:
		     --   For a BoxTv, this type must be non-boxy
                     --   For a TauTv, this type must be a tau-type
334 335

data SkolemInfo
336 337 338 339 340
  = SigSkol UserTypeCtxt	-- A skolem that is created by instantiating
				-- a programmer-supplied type signature
				-- Location of the binding site is on the TyVar

	-- The rest are for non-scoped skolems
341 342 343 344 345 346 347 348 349 350
  | ClsSkol Class	-- Bound at a class decl
  | InstSkol Id		-- Bound at an instance decl
  | PatSkol DataCon	-- An existential type variable bound by a pattern for
	    SrcSpan	-- a data constructor with an existential type. E.g.
			--	data T = forall a. Eq a => MkT a
			-- 	f (MkT x) = ...
			-- The pattern MkT x will allocate an existential type
			-- variable for 'a'.  
  | ArrowSkol SrcSpan	-- An arrow form (see TcArrows)

351 352
  | GenSkol [TcTyVar]	-- Bound when doing a subsumption check for 
	    TcType	-- 	(forall tvs. ty)
353 354
	    SrcSpan

355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388
  | UnkSkol		-- Unhelpful info (until I improve it)

-------------------------------------
-- UserTypeCtxt describes the places where a 
-- programmer-written type signature can occur
data UserTypeCtxt 
  = FunSigCtxt Name	-- Function type signature
			-- Also used for types in SPECIALISE pragmas
  | ExprSigCtxt		-- Expression type signature
  | ConArgCtxt Name	-- Data constructor argument
  | TySynCtxt Name	-- RHS of a type synonym decl
  | GenPatCtxt		-- Pattern in generic decl
			-- 	f{| a+b |} (Inl x) = ...
  | LamPatSigCtxt		-- Type sig in lambda pattern
			-- 	f (x::t) = ...
  | BindPatSigCtxt	-- Type sig in pattern binding pattern
			--	(x::t, y) = e
  | ResSigCtxt		-- Result type sig
			-- 	f x :: t = ....
  | ForSigCtxt Name	-- Foreign inport or export signature
  | RuleSigCtxt Name 	-- Signature on a forall'd variable in a RULE
  | DefaultDeclCtxt	-- Types in a default declaration
  | SpecInstCtxt	-- SPECIALISE instance pragma

-- Notes re TySynCtxt
-- We allow type synonyms that aren't types; e.g.  type List = []
--
-- If the RHS mentions tyvars that aren't in scope, we'll 
-- quantify over them:
--	e.g. 	type T = a->a
-- will become	type T = forall a. a->a
--
-- With gla-exts that's right, but for H98 we should complain. 
\end{code}
389

390 391 392 393 394
%************************************************************************
%*									*
		Pretty-printing
%*									*
%************************************************************************
395

396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419
\begin{code}
pprTcTyVarDetails :: TcTyVarDetails -> SDoc
-- For debugging
pprTcTyVarDetails (SkolemTv _)         = ptext SLIT("sk")
pprTcTyVarDetails (MetaTv BoxTv _)     = ptext SLIT("box")
pprTcTyVarDetails (MetaTv TauTv _)     = ptext SLIT("tau")
pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext SLIT("sig")

pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt n)  = ptext SLIT("the type signature for") <+> quotes (ppr n)
pprUserTypeCtxt ExprSigCtxt     = ptext SLIT("an expression type signature")
pprUserTypeCtxt (ConArgCtxt c)  = ptext SLIT("the type of the constructor") <+> quotes (ppr c)
pprUserTypeCtxt (TySynCtxt c)   = ptext SLIT("the RHS of the type synonym") <+> quotes (ppr c)
pprUserTypeCtxt GenPatCtxt      = ptext SLIT("the type pattern of a generic definition")
pprUserTypeCtxt LamPatSigCtxt   = ptext SLIT("a pattern type signature")
pprUserTypeCtxt BindPatSigCtxt  = ptext SLIT("a pattern type signature")
pprUserTypeCtxt ResSigCtxt      = ptext SLIT("a result type signature")
pprUserTypeCtxt (ForSigCtxt n)  = ptext SLIT("the foreign declaration for") <+> quotes (ppr n)
pprUserTypeCtxt (RuleSigCtxt n) = ptext SLIT("the type signature for") <+> quotes (ppr n)
pprUserTypeCtxt DefaultDeclCtxt = ptext SLIT("a type in a `default' declaration")
pprUserTypeCtxt SpecInstCtxt    = ptext SLIT("a SPECIALISE instance pragma")


--------------------------------
420 421 422
tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
-- Tidy the type inside a GenSkol, preparatory to printing it
tidySkolemTyVar env tv
423
  = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
424
    (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
425
  where
426
    (env1, info1) = case tcTyVarDetails tv of
427 428 429 430 431 432 433 434 435
			SkolemTv info -> (env1, SkolemTv info')
				where
				  (env1, info') = tidy_skol_info env info
			MetaTv (SigTv info) box -> (env1, MetaTv (SigTv info') box)
				where
				  (env1, info') = tidy_skol_info env info
			info -> (env, info)

    tidy_skol_info env (GenSkol tvs ty loc) = (env2, GenSkol tvs1 ty1 loc)
436 437 438
			    where
			      (env1, tvs1) = tidyOpenTyVars env tvs
			      (env2, ty1)  = tidyOpenType env1 ty
439
    tidy_skol_info env info = (env, info)
440
		     
441 442 443 444 445
pprSkolTvBinding :: TcTyVar -> SDoc
-- Print info about the binding of a skolem tyvar, 
-- or nothing if we don't have anything useful to say
pprSkolTvBinding tv
  = ppr_details (tcTyVarDetails tv)
446
  where
447 448 449 450 451 452 453 454 455
    ppr_details (MetaTv TauTv _)   = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
    ppr_details (MetaTv BoxTv _)   = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
    ppr_details (MetaTv (SigTv info) _) = ppr_skol info
    ppr_details (SkolemTv info)		= ppr_skol info

    ppr_skol UnkSkol 	     = empty	-- Unhelpful; omit
    ppr_skol (SigSkol ctxt)  = sep [quotes (ppr tv) <+> ptext SLIT("is bound by") <+> pprUserTypeCtxt ctxt,
				    nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]
    ppr_skol info            = quotes (ppr tv) <+> pprSkolInfo info
456 457
 
pprSkolInfo :: SkolemInfo -> SDoc
458 459 460 461 462
pprSkolInfo (SigSkol ctxt)   = ptext SLIT("is bound by") <+> pprUserTypeCtxt ctxt
pprSkolInfo (ClsSkol cls)    = ptext SLIT("is bound by the class declaration for") <+> quotes (ppr cls)
pprSkolInfo (InstSkol df)    = ptext SLIT("is bound by the instance declaration at") <+> ppr (getSrcLoc df)
pprSkolInfo (ArrowSkol loc)  = ptext SLIT("is bound by the arrow form at") <+> ppr loc
pprSkolInfo (PatSkol dc loc) = sep [ptext SLIT("is bound by the pattern for") <+> quotes (ppr dc),
463
           		            nest 2 (ptext SLIT("at") <+> ppr loc)]
464 465
pprSkolInfo (GenSkol tvs ty loc) = sep [sep [ptext SLIT("is bound by the polymorphic type"), 
				   	     nest 2 (quotes (ppr (mkForAllTys tvs ty)))],
466
				        nest 2 (ptext SLIT("at") <+> ppr loc)]
467 468 469 470
-- UnkSkol, SigSkol
-- For type variables the others are dealt with by pprSkolTvBinding.  
-- For Insts, these cases should not happen
pprSkolInfo UnkSkol = panic "UnkSkol"
471 472 473 474

instance Outputable MetaDetails where
  ppr Flexi 	    = ptext SLIT("Flexi")
  ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
475 476
\end{code}

477

478 479 480 481 482 483 484 485
%************************************************************************
%*									*
		Predicates
%*									*
%************************************************************************

\begin{code}
isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isBoxyTyVar, isMetaTyVar :: TyVar -> Bool
486 487 488 489 490 491 492
isImmutableTyVar tv
  | isTcTyVar tv = isSkolemTyVar tv
  | otherwise    = True

isSkolemTyVar tv 
  = ASSERT( isTcTyVar tv )
    case tcTyVarDetails tv of
493 494
	SkolemTv _         -> True
 	MetaTv _ _         -> False
495

496 497 498 499 500 501
isExistentialTyVar tv 	-- Existential type variable, bound by a pattern
  = ASSERT( isTcTyVar tv )
    case tcTyVarDetails tv of
	SkolemTv (PatSkol _ _) -> True
	other 		       -> False

502
isMetaTyVar tv 
503
  = ASSERT2( isTcTyVar tv, ppr tv )
504
    case tcTyVarDetails tv of
505
	MetaTv _ _ -> True
506
	other      -> False
507

508 509 510 511 512 513 514 515 516 517 518 519
isBoxyTyVar tv 
  = ASSERT( isTcTyVar tv )
    case tcTyVarDetails tv of
	MetaTv BoxTv _ -> True
	other          -> False

isSigTyVar tv 
  = ASSERT( isTcTyVar tv )
    case tcTyVarDetails tv of
	MetaTv (SigTv _) _ -> True
	other              -> False

520 521 522 523
metaTvRef :: TyVar -> IORef MetaDetails
metaTvRef tv 
  = ASSERT( isTcTyVar tv )
    case tcTyVarDetails tv of
524
	MetaTv _ ref -> ref
525
	other	   -> pprPanic "metaTvRef" (ppr tv)
526 527 528 529 530 531 532

isFlexi, isIndirect :: MetaDetails -> Bool
isFlexi Flexi = True
isFlexi other = False

isIndirect (Indirect _) = True
isIndirect other        = False
533
\end{code}
534

535 536 537 538 539 540 541 542

%************************************************************************
%*									*
\subsection{Tau, sigma and rho}
%*									*
%************************************************************************

\begin{code}
543
mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
sof's avatar
sof committed
544

545
mkPhiTy :: [PredType] -> Type -> Type
546
mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
547 548
\end{code}

549
@isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
sof's avatar
sof committed
550

551
\begin{code}
552
isTauTy :: Type -> Bool
553
isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583
isTauTy (TyVarTy tv)	 = ASSERT( not (isTcTyVar tv && isBoxyTyVar tv) )
			   True
isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
isTauTy (AppTy a b)	  = isTauTy a && isTauTy b
isTauTy (FunTy a b)	  = isTauTy a && isTauTy b
isTauTy (PredTy p)	  = True		-- Don't look through source types
isTauTy other		  = False


isTauTyCon :: TyCon -> Bool
-- Returns False for type synonyms whose expansion is a polytype
isTauTyCon tc | isSynTyCon tc = isTauTy (snd (synTyConDefn tc))
	      | otherwise     = True

---------------
isBoxyTy :: TcType -> Bool
isBoxyTy ty = any isBoxyTyVar (varSetElems (tcTyVarsOfType ty))

isRigidTy :: TcType -> Bool
-- A type is rigid if it has no meta type variables in it
isRigidTy ty = all isSkolemTyVar (varSetElems (tcTyVarsOfType ty))

isRefineableTy :: TcType -> Bool
-- A type should have type refinements applied to it if it has
-- free type variables, and they are all rigid
isRefineableTy ty = not (null tc_tvs) && all isSkolemTyVar tc_tvs
		    where
		      tc_tvs = varSetElems (tcTyVarsOfType ty)

---------------
584 585
getDFunTyKey :: Type -> OccName	-- Get some string from a type, to be used to 
				-- construct a dictionary function name
586
getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
587 588 589 590 591 592 593
getDFunTyKey (TyVarTy tv)    = getOccName tv
getDFunTyKey (TyConApp tc _) = getOccName tc
getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
getDFunTyKey (FunTy arg _)   = getOccName funTyCon
getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
getDFunTyKey ty		     = pprPanic "getDFunTyKey" (pprType ty)
-- PredTy shouldn't happen
sof's avatar
sof committed
594 595 596
\end{code}


597 598
%************************************************************************
%*									*
599
\subsection{Expanding and splitting}
600 601
%*									*
%************************************************************************
602

603 604 605 606 607 608 609 610
These tcSplit functions are like their non-Tc analogues, but
	a) they do not look through newtypes
	b) they do not look through PredTys
	c) [future] they ignore usage-type annotations

However, they are non-monadic and do not follow through mutable type
variables.  It's up to you to make sure this doesn't matter.

611
\begin{code}
612 613 614
tcSplitForAllTys :: Type -> ([TyVar], Type)
tcSplitForAllTys ty = split ty ty []
   where
615
     split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
616 617 618
     split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
     split orig_ty t		    tvs = (reverse tvs, orig_ty)

619
tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
620 621 622
tcIsForAllTy (ForAllTy tv ty) = True
tcIsForAllTy t		      = False

623 624
tcSplitPhiTy :: Type -> ([PredType], Type)
tcSplitPhiTy ty = split ty ty []
625
 where
626
  split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
627 628 629 630 631 632
  split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
					Just p  -> split res res (p:ts)
					Nothing -> (reverse ts, orig_ty)
  split orig_ty ty		ts = (reverse ts, orig_ty)

tcSplitSigmaTy ty = case tcSplitForAllTys ty of
633
			(tvs, rho) -> case tcSplitPhiTy rho of
634 635
					(theta, tau) -> (tvs, theta, tau)

636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654
-----------------------
tcMultiSplitSigmaTy
	:: TcSigmaType
	-> ( [([TyVar], ThetaType)],	-- forall as.C => forall bs.D
	     TcSigmaType)		-- The rest of the type

-- We need a loop here because we are now prepared to entertain
-- types like
-- 	f:: forall a. Eq a => forall b. Baz b => tau
-- We want to instantiate this to
-- 	f2::tau		{f2 = f1 b (Baz b), f1 = f a (Eq a)}

tcMultiSplitSigmaTy sigma
  = case (tcSplitSigmaTy sigma) of
	([],[],ty) -> ([], sigma)
	(tvs, theta, ty) -> case tcMultiSplitSigmaTy ty of
				(pairs, rest) -> ((tvs,theta):pairs, rest)

-----------------------
655 656 657 658 659 660 661 662 663 664 665 666
tcTyConAppTyCon :: Type -> TyCon
tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)

tcTyConAppArgs :: Type -> [Type]
tcTyConAppArgs ty = snd (tcSplitTyConApp ty)

tcSplitTyConApp :: Type -> (TyCon, [Type])
tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
			Just stuff -> stuff
			Nothing	   -> pprPanic "tcSplitTyConApp" (pprType ty)

tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
667
tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
668 669
tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
tcSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
670
	-- Newtypes are opaque, so they may be split
671 672
	-- However, predicates are not treated
	-- as tycon applications by the type checker
673
tcSplitTyConApp_maybe other	      	= Nothing
674

675
-----------------------
676 677 678 679 680 681 682 683
tcSplitFunTys :: Type -> ([Type], Type)
tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
			Nothing	       -> ([], ty)
			Just (arg,res) -> (arg:args, res')
				       where
					  (args,res') = tcSplitFunTys res

tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
684
tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
685 686 687
tcSplitFunTy_maybe (FunTy arg res)  = Just (arg, res)
tcSplitFunTy_maybe other	    = Nothing

688 689 690 691 692 693 694 695 696 697 698 699 700 701 702
tcSplitFunTysN
	:: TcRhoType 
	-> Arity		-- N: Number of desired args
	-> ([TcSigmaType], 	-- Arg types (N or fewer)
	    TcSigmaType)	-- The rest of the type

tcSplitFunTysN ty n_args
  | n_args == 0
  = ([], ty)
  | Just (arg,res) <- tcSplitFunTy_maybe ty
  = case tcSplitFunTysN res (n_args - 1) of
	(args, res) -> (arg:args, res)
  | otherwise
  = ([], ty)

703 704 705 706
tcFunArgTy    ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }


707
-----------------------
708
tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
709
tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
710 711 712 713 714 715
tcSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
tcSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
					Just (tys', ty') -> Just (TyConApp tc tys', ty')
					Nothing		 -> Nothing
tcSplitAppTy_maybe other	     = Nothing
716 717 718 719 720

tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
		    Just stuff -> stuff
		    Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)

721 722 723 724 725 726 727 728
tcSplitAppTys :: Type -> (Type, [Type])
tcSplitAppTys ty
  = go ty []
  where
    go ty args = case tcSplitAppTy_maybe ty of
		   Just (ty', arg) -> go ty' (arg:args)
		   Nothing	   -> (ty,args)

729
-----------------------
730
tcGetTyVar_maybe :: Type -> Maybe TyVar
731
tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
732 733 734 735 736 737 738 739 740
tcGetTyVar_maybe (TyVarTy tv) 	= Just tv
tcGetTyVar_maybe other	        = Nothing

tcGetTyVar :: String -> Type -> TyVar
tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)

tcIsTyVarTy :: Type -> Bool
tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)

741
-----------------------
742
tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
743 744
-- Split the type of a dictionary function
tcSplitDFunTy ty 
745 746
  = case tcSplitSigmaTy ty   of { (tvs, theta, tau) ->
    case tcSplitDFunHead tau of { (clas, tys) -> 
747
    (tvs, theta, clas, tys) }}
748 749 750 751 752

tcSplitDFunHead :: Type -> (Class, [Type])
tcSplitDFunHead tau  
  = case tcSplitPredTy_maybe tau of 
	Just (ClassP clas tys) -> (clas, tys)
753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770

tcValidInstHeadTy :: Type -> Bool
-- Used in Haskell-98 mode, for the argument types of an instance head
-- These must not be type synonyms, but everywhere else type synonyms
-- are transparent, so we need a special function here
tcValidInstHeadTy ty
  = case ty of
	NoteTy _ ty     -> tcValidInstHeadTy ty
	TyConApp tc tys -> not (isSynTyCon tc) && ok tys
	FunTy arg res   -> ok [arg, res]
	other		-> False
  where
	-- Check that all the types are type variables,
	-- and that each is distinct
    ok tys = equalLength tvs tys && hasNoDups tvs
	   where
	     tvs = mapCatMaybes get_tv tys

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
771 772
    get_tv (NoteTy _ ty) = get_tv ty 	-- Again, do not look
    get_tv (TyVarTy tv)  = Just tv	-- through synonyms
773
    get_tv other  	 = Nothing
774 775
\end{code}

776

777 778 779

%************************************************************************
%*									*
780
\subsection{Predicate types}
781 782
%*									*
%************************************************************************
783

784
\begin{code}
785 786
tcSplitPredTy_maybe :: Type -> Maybe PredType
   -- Returns Just for predicates only
787
tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
788
tcSplitPredTy_maybe (PredTy p)    = Just p
789
tcSplitPredTy_maybe other	  = Nothing
790
	
791
predTyUnique :: PredType -> Unique
792
predTyUnique (IParam n _)      = getUnique (ipNameName n)
793 794
predTyUnique (ClassP clas tys) = getUnique clas

795
mkPredName :: Unique -> SrcLoc -> PredType -> Name
796 797
mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
mkPredName uniq loc (IParam ip ty)   = mkInternalName uniq (getOccName (ipNameName ip)) loc
798 799
\end{code}

800 801

--------------------- Dictionary types ---------------------------------
802 803

\begin{code}
804
mkClassPred clas tys = ClassP clas tys
805

806
isClassPred :: PredType -> Bool
807 808 809
isClassPred (ClassP clas tys) = True
isClassPred other	      = False

810
isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
811 812
isTyVarClassPred other		   = False

813
getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
814 815 816 817 818 819 820
getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
getClassPredTys_maybe _		        = Nothing

getClassPredTys :: PredType -> (Class, [Type])
getClassPredTys (ClassP clas tys) = (clas, tys)

mkDictTy :: Class -> [Type] -> Type
821
mkDictTy clas tys = mkPredTy (ClassP clas tys)
822 823

isDictTy :: Type -> Bool
824
isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
825 826
isDictTy (PredTy p) = isClassPred p
isDictTy other	    = False
827
\end{code}
828

829 830 831
--------------------- Implicit parameters ---------------------------------

\begin{code}
832
isIPPred :: PredType -> Bool
833 834 835
isIPPred (IParam _ _) = True
isIPPred other	      = False

836
isInheritablePred :: PredType -> Bool
837 838 839 840 841 842 843 844
-- Can be inherited by a context.  For example, consider
--	f x = let g y = (?v, y+x)
--	      in (g 3 with ?v = 8, 
--		  g 4 with ?v = 9)
-- The point is that g's type must be quantifed over ?v:
--	g :: (?v :: a) => a -> a
-- but it doesn't need to be quantified over the Num a dictionary
-- which can be free in g's rhs, and shared by both calls to g
845 846 847 848 849 850
isInheritablePred (ClassP _ _) = True
isInheritablePred other	     = False

isLinearPred :: TcPredType -> Bool
isLinearPred (IParam (Linear n) _) = True
isLinearPred other		   = False
851
\end{code}
852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872

--------------------- The stupid theta (sigh) ---------------------------------

\begin{code}
dataConsStupidTheta :: [DataCon] -> ThetaType
-- Union the stupid thetas from all the specified constructors (non-empty)
-- All the constructors should have the same result type, modulo alpha conversion
-- The resulting ThetaType uses type variables from the *first* constructor in the list
--
-- It's here because it's used in MkId.mkRecordSelId, and in TcExpr
dataConsStupidTheta (con1:cons)
  = nubBy tcEqPred all_preds
  where
    all_preds 	  = dataConStupidTheta con1 ++ other_stupids
    res_tys1  	  = dataConResTys con1
    tvs1      	  = tyVarsOfTypes res_tys1
    other_stupids = [ substPred subst pred
		    | con <- cons
		    , let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
		    , pred <- dataConStupidTheta con ]
\end{code}
873 874


875 876 877 878 879
%************************************************************************
%*									*
\subsection{Predicates}
%*									*
%************************************************************************
880

881
isSigmaTy returns true of any qualified type.  It doesn't *necessarily* have 
882 883
any foralls.  E.g.
	f :: (?x::Int) => Int -> Int
884

885
\begin{code}
886
isSigmaTy :: Type -> Bool
887
isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
888 889 890
isSigmaTy (ForAllTy tyvar ty) = True
isSigmaTy (FunTy a b)	      = isPredTy a
isSigmaTy _		      = False
891 892

isOverloadedTy :: Type -> Bool
893
isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
894 895 896
isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
isOverloadedTy (FunTy a b)	   = isPredTy a
isOverloadedTy _		   = False
897 898 899

isPredTy :: Type -> Bool	-- Belongs in TcType because it does 
				-- not look through newtypes, or predtypes (of course)
900
isPredTy ty | Just ty' <- tcView ty = isPredTy ty'
901 902
isPredTy (PredTy sty)  = True
isPredTy _	       = False
903
\end{code}
904 905

\begin{code}
906 907 908 909 910
isFloatTy      = is_tc floatTyConKey
isDoubleTy     = is_tc doubleTyConKey
isIntegerTy    = is_tc integerTyConKey
isIntTy        = is_tc intTyConKey
isBoolTy       = is_tc boolTyConKey
911
isUnitTy       = is_tc unitTyConKey
912 913 914 915 916 917 918

is_tc :: Unique -> Type -> Bool
-- Newtypes are opaque to this
is_tc uniq ty = case tcSplitTyConApp_maybe ty of
			Just (tc, _) -> uniq == getUnique tc
			Nothing	     -> False
\end{code}
919

920

921 922
%************************************************************************
%*									*
923
\subsection{Misc}
924 925 926 927
%*									*
%************************************************************************

\begin{code}
928 929 930 931
deNoteType :: Type -> Type
-- Remove all *outermost* type synonyms and other notes
deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
deNoteType ty = ty
932 933
\end{code}

934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953
\begin{code}
tcTyVarsOfType :: Type -> TcTyVarSet
-- Just the tc type variables free in the type
tcTyVarsOfType (TyVarTy tv)	    = if isTcTyVar tv then unitVarSet tv
						      else emptyVarSet
tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys
tcTyVarsOfType (NoteTy _ ty)	    = tcTyVarsOfType ty
tcTyVarsOfType (PredTy sty)	    = tcTyVarsOfPred sty
tcTyVarsOfType (FunTy arg res)	    = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
tcTyVarsOfType (AppTy fun arg)	    = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
tcTyVarsOfType (ForAllTy tyvar ty)  = tcTyVarsOfType ty `delVarSet` tyvar
	-- We do sometimes quantify over skolem TcTyVars

tcTyVarsOfTypes :: [Type] -> TyVarSet
tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys

tcTyVarsOfPred :: PredType -> TyVarSet
tcTyVarsOfPred (IParam _ ty)  = tcTyVarsOfType ty
tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
\end{code}
954

955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972
Note [Silly type synonym]
~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
	type T a = Int
What are the free tyvars of (T x)?  Empty, of course!  
Here's the example that Ralf Laemmel showed me:
	foo :: (forall a. C u a -> C u a) -> u
	mappend :: Monoid u => u -> u -> u

	bar :: Monoid u => u
	bar = foo (\t -> t `mappend` t)
We have to generalise at the arg to f, and we don't
want to capture the constraint (Monad (C u a)) because
it appears to mention a.  Pretty silly, but it was useful to him.

exactTyVarsOfType is used by the type checker to figure out exactly
which type variables are mentioned in a type.  It's also used in the
smart-app checking code --- see TcExpr.tcIdApp
973 974

\begin{code}
975 976
exactTyVarsOfType :: TcType -> TyVarSet
-- Find the free type variables (of any kind)
977
-- but *expand* type synonyms.  See Note [Silly type synonym] above.
978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993
exactTyVarsOfType ty
  = go ty
  where
    go ty | Just ty' <- tcView ty = go ty'	-- This is the key line
    go (TyVarTy tv)         	  = unitVarSet tv
    go (TyConApp tycon tys) 	  = exactTyVarsOfTypes tys
    go (PredTy ty)	    	  = go_pred ty
    go (FunTy arg res)	    	  = go arg `unionVarSet` go res
    go (AppTy fun arg)	    	  = go fun `unionVarSet` go arg
    go (ForAllTy tyvar ty)  	  = delVarSet (go ty) tyvar

    go_pred (IParam _ ty)  = go ty
    go_pred (ClassP _ tys) = exactTyVarsOfTypes tys

exactTyVarsOfTypes :: [TcType] -> TyVarSet
exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
994 995
\end{code}

996 997
Find the free tycons and classes of a type.  This is used in the front
end of the compiler.
998

999
\begin{code}
1000 1001 1002
tyClsNamesOfType :: Type -> NameSet
tyClsNamesOfType (TyVarTy tv)		    = emptyNameSet
tyClsNamesOfType (TyConApp tycon tys)	    = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
1003
tyClsNamesOfType (NoteTy _ ty2) 	    = tyClsNamesOfType ty2
1004 1005
tyClsNamesOfType (PredTy (IParam n ty))     = tyClsNamesOfType ty
tyClsNamesOfType (PredTy (ClassP cl tys))   = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
1006 1007 1008 1009 1010 1011 1012
tyClsNamesOfType (FunTy arg res)	    = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
tyClsNamesOfType (AppTy fun arg)	    = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
tyClsNamesOfType (ForAllTy tyvar ty)	    = tyClsNamesOfType ty

tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys

tyClsNamesOfDFunHead :: Type -> NameSet
1013 1014 1015 1016 1017 1018
-- Find the free type constructors and classes 
-- of the head of the dfun instance type
-- The 'dfun_head_type' is because of
--	instance Foo a => Baz T where ...
-- The decl is an orphan if Baz and T are both not locally defined,
--	even if Foo *is* locally defined
1019 1020 1021 1022
tyClsNamesOfDFunHead dfun_ty 
  = case tcSplitSigmaTy dfun_ty of
	(tvs,_,head_ty) -> tyClsNamesOfType head_ty

1023
classesOfTheta :: ThetaType -> [Class]
1024
-- Looks just for ClassP things; maybe it should check
1025
classesOfTheta preds = [ c | ClassP c _ <- preds ]
1026 1027 1028
\end{code}


1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039
%************************************************************************
%*									*
\subsection[TysWiredIn-ext-type]{External types}
%*									*
%************************************************************************

The compiler's foreign function interface supports the passing of a
restricted set of types as arguments and results (the restricting factor
being the )

\begin{code}
1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056
tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
-- (isIOType t) returns (Just (IO,t')) if t is of the form (IO t'), or
--				       some newtype wrapping thereof
--		returns Nothing otherwise
tcSplitIOType_maybe ty 
  | Just (io_tycon, [io_res_ty]) <- tcSplitTyConApp_maybe ty,
	-- This split absolutely has to be a tcSplit, because we must
	-- see the IO type; and it's a newtype which is transparent to splitTyConApp.
    io_tycon `hasKey` ioTyConKey
  = Just (io_tycon, io_res_ty)

  | Just ty' <- coreView ty	-- Look through non-recursive newtypes
  = tcSplitIOType_maybe ty'

  | otherwise
  = Nothing

1057 1058 1059 1060
isFFITy :: Type -> Bool
-- True for any TyCon that can possibly be an arg or result of an FFI call
isFFITy ty = checkRepTyCon legalFFITyCon ty

1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079
isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
-- Checks for valid argument type for a 'foreign import'
isFFIArgumentTy dflags safety ty 
   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty

isFFIExternalTy :: Type -> Bool
-- Types that are allowed as arguments of a 'foreign export'
isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty

isFFIImportResultTy :: DynFlags -> Type -> Bool
isFFIImportResultTy dflags ty 
  = checkRepTyCon (legalFIResultTyCon dflags) ty

isFFIExportResultTy :: Type -> Bool
isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty

isFFIDynArgumentTy :: Type -> Bool
-- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
-- or a newtype of either.
1080
isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1081 1082 1083