2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[TcType]{Types used in the typechecker}
7 This module provides the Type interface for front-end parts of the
10 * treat "source types" as opaque:
11 newtypes, and predicates are meaningful.
12 * look through usage types
14 The "tc" prefix is for "TypeChecker", because the type checker
15 is the principal client.
19 --------------------------------
21 TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
22 TcTyVar, TcTyVarSet, TcKind, TcCoVar,
24 --------------------------------
26 UserTypeCtxt(..), pprUserTypeCtxt,
27 TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
28 MetaDetails(Flexi, Indirect), MetaInfo(..),
29 isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isMetaTyVarTy,
30 isSigTyVar, isOverlappableTyVar, isTyConableTyVar,
32 isFlexi, isIndirect, isRuntimeUnkSkol,
34 --------------------------------
38 --------------------------------
40 -- These are important because they do not look through newtypes
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,
50 ---------------------------------
52 -- Again, newtypes are opaque
53 tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
55 isSigmaTy, isOverloadedTy,
56 isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
57 isIntegerTy, isBoolTy, isUnitTy, isCharTy,
58 isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
61 ---------------------------------
62 -- Misc type manipulators
64 orphNamesOfType, orphNamesOfDFunHead,
67 ---------------------------------
69 getClassPredTys_maybe, getClassPredTys,
70 isClassPred, isTyVarClassPred, isEqPred,
71 mkClassPred, mkIPPred, tcSplitPredTy_maybe,
73 isPredTy, isDictTy, isDictLikeTy,
74 tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
76 mkMinimalBySCs, transSuperClasses, immSuperClasses,
78 -- * Tidying type related things up for printing
80 tidyOpenType, tidyOpenTypes,
81 tidyTyVarBndr, tidyFreeTyVars,
82 tidyOpenTyVar, tidyOpenTyVars,
83 tidyTopType, tidyPred,
86 ---------------------------------
87 -- Foreign import and export
88 isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
89 isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
90 isFFIExportResultTy, -- :: Type -> Bool
91 isFFIExternalTy, -- :: Type -> Bool
92 isFFIDynArgumentTy, -- :: Type -> Bool
93 isFFIDynResultTy, -- :: Type -> Bool
94 isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
95 isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
96 isFFILabelTy, -- :: Type -> Bool
97 isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
98 isFFIDotnetObjTy, -- :: Type -> Bool
99 isFFITy, -- :: Type -> Bool
100 isFunPtrTy, -- :: Type -> Bool
101 tcSplitIOType_maybe, -- :: Type -> Maybe Type
103 --------------------------------
104 -- Rexported from Coercion
107 --------------------------------
108 -- Rexported from Type
109 Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
110 unliftedTypeKind, liftedTypeKind, argTypeKind,
111 openTypeKind, mkArrowKind, mkArrowKinds,
112 isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
113 isSubArgTypeKind, isSubKind, splitKindFunTys, defaultKind,
114 kindVarRef, mkKindVar,
116 Type, PredType(..), ThetaType,
117 mkForAllTy, mkForAllTys,
118 mkFunTy, mkFunTys, zipFunTys,
119 mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
120 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
122 -- Type substitutions
123 TvSubst(..), -- Representation visible to a few friends
124 TvSubstEnv, emptyTvSubst, substEqSpec,
125 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst,
126 mkTopTvSubst, notElemTvSubst, unionTvSubst,
127 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
128 extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
129 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
131 isUnLiftedType, -- Source types are always lifted
132 isUnboxedTupleType, -- Ditto
135 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
136 tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
139 pprKind, pprParendKind,
140 pprType, pprParendType, pprTypeApp, pprTyThingCategory,
141 pprPred, pprTheta, pprThetaArrow, pprClassPred
145 #include "HsVersions.h"
171 import Data.List( mapAccumL )
175 %************************************************************************
179 %************************************************************************
181 The type checker divides the generic Type world into the
182 following more structured beasts:
184 sigma ::= forall tyvars. phi
185 -- A sigma type is a qualified type
187 -- Note that even if 'tyvars' is empty, theta
188 -- may not be: e.g. (?x::Int) => Int
190 -- Note that 'sigma' is in prenex form:
191 -- all the foralls are at the front.
192 -- A 'phi' type has no foralls to the right of
200 -- A 'tau' type has no quantification anywhere
201 -- Note that the args of a type constructor must be taus
203 | tycon tau_1 .. tau_n
207 -- In all cases, a (saturated) type synonym application is legal,
208 -- provided it expands to the required form.
211 type TcTyVar = TyVar -- Used only during type inference
212 type TcCoVar = CoVar -- Used only during type inference; mutable
213 type TcType = Type -- A TcType can have mutable type variables
214 -- Invariant on ForAllTy in TcTypes:
216 -- a cannot occur inside a MutTyVar in T; that is,
217 -- T is "flattened" before quantifying over a
219 -- These types do not have boxy type variables in them
220 type TcPredType = PredType
221 type TcThetaType = ThetaType
222 type TcSigmaType = TcType
223 type TcRhoType = TcType
224 type TcTauType = TcType
226 type TcTyVarSet = TyVarSet
230 %************************************************************************
232 \subsection{TyVarDetails}
234 %************************************************************************
236 TyVarDetails gives extra info about type variables, used during type
237 checking. It's attached to mutable type variables only.
238 It's knot-tied back to Var.lhs. There is no reason in principle
239 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
242 Note [Signature skolems]
243 ~~~~~~~~~~~~~~~~~~~~~~~~
248 (x,y,z) = ([y,z], z, head x)
250 Here, x and y have type sigs, which go into the environment. We used to
251 instantiate their types with skolem constants, and push those types into
252 the RHS, so we'd typecheck the RHS with type
254 where a*, b* are skolem constants, and c is an ordinary meta type varible.
256 The trouble is that the occurrences of z in the RHS force a* and b* to
257 be the *same*, so we can't make them into skolem constants that don't unify
258 with each other. Alas.
260 One solution would be insist that in the above defn the programmer uses
261 the same type variable in both type signatures. But that takes explanation.
263 The alternative (currently implemented) is to have a special kind of skolem
264 constant, SigTv, which can unify with other SigTvs. These are *not* treated
265 as righd for the purposes of GADTs. And they are used *only* for pattern
266 bindings and mutually recursive function bindings. See the function
267 TcBinds.tcInstSig, and its use_skols parameter.
271 -- A TyVarDetails is inside a TyVar
273 = SkolemTv -- A skolem
274 Bool -- True <=> this skolem type variable can be overlapped
275 -- when looking up instances
276 -- See Note [Binding when looking up instances] in InstEnv
278 | RuntimeUnk -- Stands for an as-yet-unknown type in the GHCi
279 -- interactive context
282 -- The "skolem" obtained by flattening during
283 -- constraint simplification
285 -- In comments we will use the notation alpha[flat = ty]
286 -- to represent a flattening skolem variable alpha
287 -- identified with type ty.
289 | MetaTv MetaInfo (IORef MetaDetails)
291 vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
292 -- See Note [Binding when looking up instances] in InstEnv
293 vanillaSkolemTv = SkolemTv False -- Might be instantiated
294 superSkolemTv = SkolemTv True -- Treat this as a completely distinct type
297 = Flexi -- Flexi type variables unify to become Indirects
300 instance Outputable MetaDetails where
301 ppr Flexi = ptext (sLit "Flexi")
302 ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
305 = TauTv -- This MetaTv is an ordinary unification variable
306 -- A TauTv is always filled in with a tau-type, which
307 -- never contains any ForAlls
309 | SigTv Name -- A variant of TauTv, except that it should not be
310 -- unified with a type, only with a type variable
311 -- SigTvs are only distinguished to improve error messages
312 -- see Note [Signature skolems]
313 -- The MetaDetails, if filled in, will
314 -- always be another SigTv or a SkolemTv
315 -- The Name is the name of the function from whose
316 -- type signature we got this skolem
318 | TcsTv -- A MetaTv allocated by the constraint solver
319 -- Its particular property is that it is always "touchable"
320 -- Nevertheless, the constraint solver has to try to guess
321 -- what type to instantiate it to
323 -------------------------------------
324 -- UserTypeCtxt describes the origin of the polymorphic type
325 -- in the places where we need to an expression has that type
328 = FunSigCtxt Name -- Function type signature
329 -- Also used for types in SPECIALISE pragmas
330 | ExprSigCtxt -- Expression type signature
331 | ConArgCtxt Name -- Data constructor argument
332 | TySynCtxt Name -- RHS of a type synonym decl
333 | GenPatCtxt -- Pattern in generic decl
334 -- f{| a+b |} (Inl x) = ...
335 | LamPatSigCtxt -- Type sig in lambda pattern
337 | BindPatSigCtxt -- Type sig in pattern binding pattern
339 | ResSigCtxt -- Result type sig
341 | ForSigCtxt Name -- Foreign inport or export signature
342 | DefaultDeclCtxt -- Types in a default declaration
343 | SpecInstCtxt -- SPECIALISE instance pragma
344 | ThBrackCtxt -- Template Haskell type brackets [t| ... |]
346 | GenSigCtxt -- Higher-rank or impredicative situations
347 -- e.g. (f e) where f has a higher-rank type
348 -- We might want to elaborate this
350 -- Notes re TySynCtxt
351 -- We allow type synonyms that aren't types; e.g. type List = []
353 -- If the RHS mentions tyvars that aren't in scope, we'll
354 -- quantify over them:
355 -- e.g. type T = a->a
356 -- will become type T = forall a. a->a
358 -- With gla-exts that's right, but for H98 we should complain.
360 ---------------------------------
363 mkKindName :: Unique -> Name
364 mkKindName unique = mkSystemName unique kind_var_occ
366 kindVarRef :: KindVar -> IORef MetaDetails
368 ASSERT ( isTcTyVar tc )
369 case tcTyVarDetails tc of
370 MetaTv TauTv ref -> ref
371 _ -> pprPanic "kindVarRef" (ppr tc)
373 mkKindVar :: Unique -> IORef MetaDetails -> KindVar
375 = mkTcTyVar (mkKindName u)
376 tySuperKind -- not sure this is right,
377 -- do we need kind vars for
381 kind_var_occ :: OccName -- Just one for all KindVars
382 -- They may be jiggled by tidying
383 kind_var_occ = mkOccName tvName "k"
386 %************************************************************************
390 %************************************************************************
393 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
395 pprTcTyVarDetails (SkolemTv {}) = ptext (sLit "sk")
396 pprTcTyVarDetails (RuntimeUnk {}) = ptext (sLit "rt")
397 pprTcTyVarDetails (FlatSkol {}) = ptext (sLit "fsk")
398 pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
399 pprTcTyVarDetails (MetaTv TcsTv _) = ptext (sLit "tcs")
400 pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
402 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
403 pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n)
404 pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature")
405 pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
406 pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
407 pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition")
408 pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]")
409 pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature")
410 pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature")
411 pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature")
412 pprUserTypeCtxt (ForSigCtxt n) = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
413 pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
414 pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma")
415 pprUserTypeCtxt GenSigCtxt = ptext (sLit "a type expected by the context")
419 %************************************************************************
421 \subsection{TidyType}
423 %************************************************************************
426 -- | This tidies up a type for printing in an error message, or in
427 -- an interface file.
429 -- It doesn't change the uniques at all, just the print names.
430 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
431 tidyTyVarBndr env@(tidy_env, subst) tyvar
432 = case tidyOccName tidy_env occ1 of
433 (tidy', occ') -> ((tidy', subst'), tyvar'')
435 subst' = extendVarEnv subst tyvar tyvar''
436 tyvar' = setTyVarName tyvar name'
438 name' = tidyNameOcc name occ'
440 -- Don't forget to tidy the kind for coercions!
441 tyvar'' | isCoVar tyvar = setTyVarKind tyvar' kind'
443 kind' = tidyType env (tyVarKind tyvar)
445 name = tyVarName tyvar
446 occ = getOccName name
447 -- System Names are for unification variables;
448 -- when we tidy them we give them a trailing "0" (or 1 etc)
449 -- so that they don't take precedence for the un-modified name
450 occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
455 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
456 -- ^ Add the free 'TyVar's to the env in tidy form,
457 -- so that we can tidy the type they are free in
458 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
461 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
462 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
465 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
466 -- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
467 -- using the environment if one has not already been allocated. See
468 -- also 'tidyTyVarBndr'
469 tidyOpenTyVar env@(_, subst) tyvar
470 = case lookupVarEnv subst tyvar of
471 Just tyvar' -> (env, tyvar') -- Already substituted
472 Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
475 tidyType :: TidyEnv -> Type -> Type
476 tidyType env@(_, subst) ty
479 go (TyVarTy tv) = case lookupVarEnv subst tv of
481 Just tv' -> expand tv'
482 go (TyConApp tycon tys) = let args = map go tys
483 in args `seqList` TyConApp tycon args
484 go (PredTy sty) = PredTy (tidyPred env sty)
485 go (AppTy fun arg) = (AppTy $! (go fun)) $! (go arg)
486 go (FunTy fun arg) = (FunTy $! (go fun)) $! (go arg)
487 go (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
489 (envp, tvp) = tidyTyVarBndr env tv
491 -- Expand FlatSkols, the skolems introduced by flattening process
492 -- We don't want to show them in type error messages
493 expand tv | isTcTyVar tv
494 , FlatSkol ty <- tcTyVarDetails tv
500 tidyTypes :: TidyEnv -> [Type] -> [Type]
501 tidyTypes env tys = map (tidyType env) tys
504 tidyPred :: TidyEnv -> PredType -> PredType
505 tidyPred env (IParam n ty) = IParam n (tidyType env ty)
506 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
507 tidyPred env (EqPred ty1 ty2) = EqPred (tidyType env ty1) (tidyType env ty2)
510 -- | Grabs the free type variables, tidies them
511 -- and then uses 'tidyType' to work over the type itself
512 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
514 = (env', tidyType env' ty)
516 env' = tidyFreeTyVars env (tyVarsOfType ty)
519 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
520 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
523 -- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
524 tidyTopType :: Type -> Type
525 tidyTopType ty = tidyType emptyTidyEnv ty
528 tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
529 tidyKind env k = tidyOpenType env k
533 %************************************************************************
537 %************************************************************************
540 isImmutableTyVar :: TyVar -> Bool
543 | isTcTyVar tv = isSkolemTyVar tv
546 isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
547 isMetaTyVar :: TcTyVar -> Bool
550 -- True of a meta-type variable that can be filled in
551 -- with a type constructor application; in particular,
553 = ASSERT( isTcTyVar tv)
554 case tcTyVarDetails tv of
555 MetaTv (SigTv _) _ -> False
559 = ASSERT2( isTcTyVar tv, ppr tv )
560 case tcTyVarDetails tv of
563 RuntimeUnk {} -> True
566 isOverlappableTyVar tv
567 = ASSERT( isTcTyVar tv )
568 case tcTyVarDetails tv of
569 SkolemTv overlappable -> overlappable
573 = ASSERT2( isTcTyVar tv, ppr tv )
574 case tcTyVarDetails tv of
578 isMetaTyVarTy :: TcType -> Bool
579 isMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv
580 isMetaTyVarTy _ = False
582 isSigTyVar :: Var -> Bool
584 = ASSERT( isTcTyVar tv )
585 case tcTyVarDetails tv of
586 MetaTv (SigTv _) _ -> True
589 metaTvRef :: TyVar -> IORef MetaDetails
591 = ASSERT2( isTcTyVar tv, ppr tv )
592 case tcTyVarDetails tv of
594 _ -> pprPanic "metaTvRef" (ppr tv)
596 isFlexi, isIndirect :: MetaDetails -> Bool
600 isIndirect (Indirect _) = True
603 isRuntimeUnkSkol :: TyVar -> Bool
604 -- Called only in TcErrors; see Note [Runtime skolems] there
606 | isTcTyVar x, RuntimeUnk <- tcTyVarDetails x = True
611 %************************************************************************
613 \subsection{Tau, sigma and rho}
615 %************************************************************************
618 mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
619 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
621 mkPhiTy :: [PredType] -> Type -> Type
622 mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
625 @isTauTy@ tests for nested for-alls. It should not be called on a boxy type.
628 isTauTy :: Type -> Bool
629 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
630 isTauTy (TyVarTy _) = True
631 isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
632 isTauTy (AppTy a b) = isTauTy a && isTauTy b
633 isTauTy (FunTy a b) = isTauTy a && isTauTy b
634 isTauTy (PredTy _) = True -- Don't look through source types
637 isTauTyCon :: TyCon -> Bool
638 -- Returns False for type synonyms whose expansion is a polytype
640 | isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
644 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
645 -- construct a dictionary function name
646 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
647 getDFunTyKey (TyVarTy tv) = getOccName tv
648 getDFunTyKey (TyConApp tc _) = getOccName tc
649 getDFunTyKey (AppTy fun _) = getDFunTyKey fun
650 getDFunTyKey (FunTy _ _) = getOccName funTyCon
651 getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
652 getDFunTyKey ty = pprPanic "getDFunTyKey" (pprType ty)
653 -- PredTy shouldn't happen
657 %************************************************************************
659 \subsection{Expanding and splitting}
661 %************************************************************************
663 These tcSplit functions are like their non-Tc analogues, but
664 a) they do not look through newtypes
665 b) they do not look through PredTys
667 However, they are non-monadic and do not follow through mutable type
668 variables. It's up to you to make sure this doesn't matter.
671 tcSplitForAllTys :: Type -> ([TyVar], Type)
672 tcSplitForAllTys ty = split ty ty []
674 split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
675 split _ (ForAllTy tv ty) tvs
676 | not (isCoVar tv) = split ty ty (tv:tvs)
677 split orig_ty _ tvs = (reverse tvs, orig_ty)
679 tcIsForAllTy :: Type -> Bool
680 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
681 tcIsForAllTy (ForAllTy tv _) = not (isCoVar tv)
682 tcIsForAllTy _ = False
684 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
685 -- Split off the first predicate argument from a type
686 tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
687 tcSplitPredFunTy_maybe (ForAllTy tv ty)
688 | isCoVar tv = Just (coVarPred tv, ty)
689 tcSplitPredFunTy_maybe (FunTy arg res)
690 | Just p <- tcSplitPredTy_maybe arg = Just (p, res)
691 tcSplitPredFunTy_maybe _
694 tcSplitPhiTy :: Type -> (ThetaType, Type)
699 = case tcSplitPredFunTy_maybe ty of
700 Just (pred, ty) -> split ty (pred:ts)
701 Nothing -> (reverse ts, ty)
703 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
704 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
705 (tvs, rho) -> case tcSplitPhiTy rho of
706 (theta, tau) -> (tvs, theta, tau)
708 -----------------------
709 tcDeepSplitSigmaTy_maybe
710 :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)
711 -- Looks for a *non-trivial* quantified type, under zero or more function arrows
712 -- By "non-trivial" we mean either tyvars or constraints are non-empty
714 tcDeepSplitSigmaTy_maybe ty
715 | Just (arg_ty, res_ty) <- tcSplitFunTy_maybe ty
716 , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty
717 = Just (arg_ty:arg_tys, tvs, theta, rho)
719 | (tvs, theta, rho) <- tcSplitSigmaTy ty
720 , not (null tvs && null theta)
721 = Just ([], tvs, theta, rho)
723 | otherwise = Nothing
725 -----------------------
726 tcTyConAppTyCon :: Type -> TyCon
727 tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
729 Nothing -> pprPanic "tcTyConAppTyCon" (pprType ty)
731 tcTyConAppArgs :: Type -> [Type]
732 tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
733 Just (_, args) -> args
734 Nothing -> pprPanic "tcTyConAppArgs" (pprType ty)
736 tcSplitTyConApp :: Type -> (TyCon, [Type])
737 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
739 Nothing -> pprPanic "tcSplitTyConApp" (pprType ty)
741 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
742 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
743 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
744 tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
745 -- Newtypes are opaque, so they may be split
746 -- However, predicates are not treated
747 -- as tycon applications by the type checker
748 tcSplitTyConApp_maybe _ = Nothing
750 -----------------------
751 tcSplitFunTys :: Type -> ([Type], Type)
752 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
754 Just (arg,res) -> (arg:args, res')
756 (args,res') = tcSplitFunTys res
758 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
759 tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
760 tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
761 tcSplitFunTy_maybe _ = Nothing
762 -- Note the (not (isPredTy arg)) guard
763 -- Consider (?x::Int) => Bool
764 -- We don't want to treat this as a function type!
765 -- A concrete example is test tc230:
766 -- f :: () -> (?p :: ()) => () -> ()
772 -> Arity -- N: Number of desired args
773 -> ([TcSigmaType], -- Arg types (N or fewer)
774 TcSigmaType) -- The rest of the type
776 tcSplitFunTysN ty n_args
779 | Just (arg,res) <- tcSplitFunTy_maybe ty
780 = case tcSplitFunTysN res (n_args - 1) of
781 (args, res) -> (arg:args, res)
785 tcSplitFunTy :: Type -> (Type, Type)
786 tcSplitFunTy ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
788 tcFunArgTy :: Type -> Type
789 tcFunArgTy ty = fst (tcSplitFunTy ty)
791 tcFunResultTy :: Type -> Type
792 tcFunResultTy ty = snd (tcSplitFunTy ty)
794 -----------------------
795 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
796 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
797 tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
799 tcSplitAppTy :: Type -> (Type, Type)
800 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
802 Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
804 tcSplitAppTys :: Type -> (Type, [Type])
808 go ty args = case tcSplitAppTy_maybe ty of
809 Just (ty', arg) -> go ty' (arg:args)
812 -----------------------
813 tcGetTyVar_maybe :: Type -> Maybe TyVar
814 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
815 tcGetTyVar_maybe (TyVarTy tv) = Just tv
816 tcGetTyVar_maybe _ = Nothing
818 tcGetTyVar :: String -> Type -> TyVar
819 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
821 tcIsTyVarTy :: Type -> Bool
822 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
824 -----------------------
825 tcSplitDFunTy :: Type -> ([TyVar], Int, Class, [Type])
826 -- Split the type of a dictionary function
827 -- We don't use tcSplitSigmaTy, because a DFun may (with NDP)
828 -- have non-Pred arguments, such as
829 -- df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
831 = case tcSplitForAllTys ty of { (tvs, rho) ->
832 case split_dfun_args 0 rho of { (n_theta, tau) ->
833 case tcSplitDFunHead tau of { (clas, tys) ->
834 (tvs, n_theta, clas, tys) }}}
836 -- Count the context of the dfun. This can be a mix of
837 -- coercion and class constraints; or (in the general NDP case)
838 -- some other function argument
839 split_dfun_args n ty | Just ty' <- tcView ty = split_dfun_args n ty'
840 split_dfun_args n (ForAllTy tv ty) = ASSERT( isCoVar tv ) split_dfun_args (n+1) ty
841 split_dfun_args n (FunTy _ ty) = split_dfun_args (n+1) ty
842 split_dfun_args n ty = (n, ty)
844 tcSplitDFunHead :: Type -> (Class, [Type])
846 = case tcSplitPredTy_maybe tau of
847 Just (ClassP clas tys) -> (clas, tys)
848 _ -> pprPanic "tcSplitDFunHead" (ppr tau)
850 tcInstHeadTyNotSynonym :: Type -> Bool
851 -- Used in Haskell-98 mode, for the argument types of an instance head
852 -- These must not be type synonyms, but everywhere else type synonyms
853 -- are transparent, so we need a special function here
854 tcInstHeadTyNotSynonym ty
856 TyConApp tc _ -> not (isSynTyCon tc)
859 tcInstHeadTyAppAllTyVars :: Type -> Bool
860 -- Used in Haskell-98 mode, for the argument types of an instance head
861 -- These must be a constructor applied to type variable arguments
862 tcInstHeadTyAppAllTyVars ty
863 | Just ty' <- tcView ty -- Look through synonyms
864 = tcInstHeadTyAppAllTyVars ty'
867 TyConApp _ tys -> ok tys
868 FunTy arg res -> ok [arg, res]
871 -- Check that all the types are type variables,
872 -- and that each is distinct
873 ok tys = equalLength tvs tys && hasNoDups tvs
875 tvs = mapCatMaybes get_tv tys
877 get_tv (TyVarTy tv) = Just tv -- through synonyms
883 %************************************************************************
885 \subsection{Predicate types}
887 %************************************************************************
890 evVarPred :: EvVar -> PredType
892 = case tcSplitPredTy_maybe (varType var) of
894 Nothing -> pprPanic "evVarPred" (ppr var <+> ppr (varType var))
896 tcSplitPredTy_maybe :: Type -> Maybe PredType
897 -- Returns Just for predicates only
898 tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
899 tcSplitPredTy_maybe (PredTy p) = Just p
900 tcSplitPredTy_maybe _ = Nothing
902 predTyUnique :: PredType -> Unique
903 predTyUnique (IParam n _) = getUnique (ipNameName n)
904 predTyUnique (ClassP clas _) = getUnique clas
905 predTyUnique (EqPred a b) = pprPanic "predTyUnique" (ppr (EqPred a b))
909 --------------------- Dictionary types ---------------------------------
912 mkClassPred :: Class -> [Type] -> PredType
913 mkClassPred clas tys = ClassP clas tys
915 isClassPred :: PredType -> Bool
916 isClassPred (ClassP _ _) = True
917 isClassPred _ = False
919 isTyVarClassPred :: PredType -> Bool
920 isTyVarClassPred (ClassP _ tys) = all tcIsTyVarTy tys
921 isTyVarClassPred _ = False
923 getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
924 getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
925 getClassPredTys_maybe _ = Nothing
927 getClassPredTys :: PredType -> (Class, [Type])
928 getClassPredTys (ClassP clas tys) = (clas, tys)
929 getClassPredTys _ = panic "getClassPredTys"
931 mkDictTy :: Class -> [Type] -> Type
932 mkDictTy clas tys = mkPredTy (ClassP clas tys)
934 isDictLikeTy :: Type -> Bool
935 -- Note [Dictionary-like types]
936 isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'
937 isDictLikeTy (PredTy p) = isClassPred p
938 isDictLikeTy (TyConApp tc tys)
939 | isTupleTyCon tc = all isDictLikeTy tys
940 isDictLikeTy _ = False
946 mkMinimalBySCs :: [PredType] -> [PredType]
947 -- Remove predicates that can be deduced from others by superclasses
948 mkMinimalBySCs ptys = [ ploc | ploc <- ptys
949 , ploc `not_in_preds` rec_scs ]
951 rec_scs = concatMap trans_super_classes ptys
952 not_in_preds p ps = null (filter (tcEqPred p) ps)
953 trans_super_classes (ClassP cls tys) = transSuperClasses cls tys
954 trans_super_classes _other_pty = []
956 transSuperClasses :: Class -> [Type] -> [PredType]
957 transSuperClasses cls tys
958 = foldl (\pts p -> trans_sc p ++ pts) [] $
959 immSuperClasses cls tys
960 where trans_sc :: PredType -> [PredType]
961 trans_sc this_pty@(ClassP cls tys)
962 = foldl (\pts p -> trans_sc p ++ pts) [this_pty] $
963 immSuperClasses cls tys
966 immSuperClasses :: Class -> [Type] -> [PredType]
967 immSuperClasses cls tys
968 = substTheta (zipTopTvSubst tyvars tys) sc_theta
969 where (tyvars,sc_theta,_,_) = classBigSig cls
972 Note [Dictionary-like types]
973 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
974 Being "dictionary-like" means either a dictionary type or a tuple thereof.
975 In GHC 6.10 we build implication constraints which construct such tuples,
976 and if we land up with a binding
979 then we want to treat t as cheap under "-fdicts-cheap" for example.
980 (Implication constraints are normally inlined, but sadly not if the
981 occurrence is itself inside an INLINE function! Until we revise the
982 handling of implication constraints, that is.) This turned out to
983 be important in getting good arities in DPH code. Example:
986 class D a where { foo :: a -> a }
987 instance C a => D (Maybe a) where { foo x = x }
989 bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
991 bar x y = (foo (Just x), foo (Just y))
993 Then 'bar' should jolly well have arity 4 (two dicts, two args), but
994 we ended up with something like
995 bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
998 This is all a bit ad-hoc; eg it relies on knowing that implication
999 constraints build tuples.
1001 --------------------- Implicit parameters ---------------------------------
1004 mkIPPred :: IPName Name -> Type -> PredType
1005 mkIPPred ip ty = IParam ip ty
1007 isIPPred :: PredType -> Bool
1008 isIPPred (IParam _ _) = True
1012 --------------------- Equality predicates ---------------------------------
1014 substEqSpec :: TvSubst -> [(TyVar,Type)] -> [(TcType,TcType)]
1015 substEqSpec subst eq_spec = [ (substTyVar subst tv, substTy subst ty)
1016 | (tv,ty) <- eq_spec]
1020 %************************************************************************
1022 \subsection{Predicates}
1024 %************************************************************************
1026 isSigmaTy returns true of any qualified type. It doesn't *necessarily* have
1028 f :: (?x::Int) => Int -> Int
1031 isSigmaTy :: Type -> Bool
1032 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
1033 isSigmaTy (ForAllTy _ _) = True
1034 isSigmaTy (FunTy a _) = isPredTy a
1037 isOverloadedTy :: Type -> Bool
1038 -- Yes for a type of a function that might require evidence-passing
1039 -- Used only by bindLocalMethods
1040 -- NB: be sure to check for type with an equality predicate; hence isCoVar
1041 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
1042 isOverloadedTy (ForAllTy tv ty) = isCoVar tv || isOverloadedTy ty
1043 isOverloadedTy (FunTy a _) = isPredTy a
1044 isOverloadedTy _ = False
1046 isPredTy :: Type -> Bool -- Belongs in TcType because it does
1047 -- not look through newtypes, or predtypes (of course)
1048 isPredTy ty | Just ty' <- tcView ty = isPredTy ty'
1049 isPredTy (PredTy _) = True
1054 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
1055 isUnitTy, isCharTy :: Type -> Bool
1056 isFloatTy = is_tc floatTyConKey
1057 isDoubleTy = is_tc doubleTyConKey
1058 isIntegerTy = is_tc integerTyConKey
1059 isIntTy = is_tc intTyConKey
1060 isWordTy = is_tc wordTyConKey
1061 isBoolTy = is_tc boolTyConKey
1062 isUnitTy = is_tc unitTyConKey
1063 isCharTy = is_tc charTyConKey
1065 isStringTy :: Type -> Bool
1067 = case tcSplitTyConApp_maybe ty of
1068 Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
1071 is_tc :: Unique -> Type -> Bool
1072 -- Newtypes are opaque to this
1073 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
1074 Just (tc, _) -> uniq == getUnique tc
1079 -- NB: Currently used in places where we have already expanded type synonyms;
1080 -- hence no 'coreView'. This could, however, be changed without breaking
1082 isSynFamilyTyConApp :: TcTauType -> Bool
1083 isSynFamilyTyConApp (TyConApp tc tys) = isSynFamilyTyCon tc &&
1084 length tys == tyConArity tc
1085 isSynFamilyTyConApp _other = False
1089 %************************************************************************
1093 %************************************************************************
1096 deNoteType :: Type -> Type
1097 -- Remove all *outermost* type synonyms and other notes
1098 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
1103 tcTyVarsOfType :: Type -> TcTyVarSet
1104 -- Just the *TcTyVars* free in the type
1105 -- (Types.tyVarsOfTypes finds all free TyVars)
1106 tcTyVarsOfType (TyVarTy tv) = if isTcTyVar tv then unitVarSet tv
1108 tcTyVarsOfType (TyConApp _ tys) = tcTyVarsOfTypes tys
1109 tcTyVarsOfType (PredTy sty) = tcTyVarsOfPred sty
1110 tcTyVarsOfType (FunTy arg res) = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
1111 tcTyVarsOfType (AppTy fun arg) = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
1112 tcTyVarsOfType (ForAllTy tyvar ty) = (tcTyVarsOfType ty `delVarSet` tyvar)
1113 `unionVarSet` tcTyVarsOfTyVar tyvar
1114 -- We do sometimes quantify over skolem TcTyVars
1116 tcTyVarsOfTyVar :: TcTyVar -> TyVarSet
1117 tcTyVarsOfTyVar tv | isCoVar tv = tcTyVarsOfType (tyVarKind tv)
1118 | otherwise = emptyVarSet
1120 tcTyVarsOfTypes :: [Type] -> TyVarSet
1121 tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
1123 tcTyVarsOfPred :: PredType -> TyVarSet
1124 tcTyVarsOfPred (IParam _ ty) = tcTyVarsOfType ty
1125 tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
1126 tcTyVarsOfPred (EqPred ty1 ty2) = tcTyVarsOfType ty1 `unionVarSet` tcTyVarsOfType ty2
1129 Note [Silly type synonym]
1130 ~~~~~~~~~~~~~~~~~~~~~~~~~
1133 What are the free tyvars of (T x)? Empty, of course!
1134 Here's the example that Ralf Laemmel showed me:
1135 foo :: (forall a. C u a -> C u a) -> u
1136 mappend :: Monoid u => u -> u -> u
1138 bar :: Monoid u => u
1139 bar = foo (\t -> t `mappend` t)
1140 We have to generalise at the arg to f, and we don't
1141 want to capture the constraint (Monad (C u a)) because
1142 it appears to mention a. Pretty silly, but it was useful to him.
1144 exactTyVarsOfType is used by the type checker to figure out exactly
1145 which type variables are mentioned in a type. It's also used in the
1146 smart-app checking code --- see TcExpr.tcIdApp
1148 On the other hand, consider a *top-level* definition
1149 f = (\x -> x) :: T a -> T a
1150 If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
1151 if we have an application like (f "x") we get a confusing error message
1152 involving Any. So the conclusion is this: when generalising
1153 - at top level use tyVarsOfType
1154 - in nested bindings use exactTyVarsOfType
1155 See Trac #1813 for example.
1158 exactTyVarsOfType :: TcType -> TyVarSet
1159 -- Find the free type variables (of any kind)
1160 -- but *expand* type synonyms. See Note [Silly type synonym] above.
1161 exactTyVarsOfType ty
1164 go ty | Just ty' <- tcView ty = go ty' -- This is the key line
1165 go (TyVarTy tv) = unitVarSet tv
1166 go (TyConApp _ tys) = exactTyVarsOfTypes tys
1167 go (PredTy ty) = go_pred ty
1168 go (FunTy arg res) = go arg `unionVarSet` go res
1169 go (AppTy fun arg) = go fun `unionVarSet` go arg
1170 go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar
1171 `unionVarSet` go_tv tyvar
1173 go_pred (IParam _ ty) = go ty
1174 go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
1175 go_pred (EqPred ty1 ty2) = go ty1 `unionVarSet` go ty2
1177 go_tv tyvar | isCoVar tyvar = go (tyVarKind tyvar)
1178 | otherwise = emptyVarSet
1180 exactTyVarsOfTypes :: [TcType] -> TyVarSet
1181 exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
1184 Find the free tycons and classes of a type. This is used in the front
1185 end of the compiler.
1188 orphNamesOfType :: Type -> NameSet
1189 orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
1190 -- Look through type synonyms (Trac #4912)
1191 orphNamesOfType (TyVarTy _) = emptyNameSet
1192 orphNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon)
1193 `unionNameSets` orphNamesOfTypes tys
1194 orphNamesOfType (PredTy (IParam _ ty)) = orphNamesOfType ty
1195 orphNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl)
1196 `unionNameSets` orphNamesOfTypes tys
1197 orphNamesOfType (PredTy (EqPred ty1 ty2)) = orphNamesOfType ty1
1198 `unionNameSets` orphNamesOfType ty2
1199 orphNamesOfType (FunTy arg res) = orphNamesOfType arg `unionNameSets` orphNamesOfType res
1200 orphNamesOfType (AppTy fun arg) = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
1201 orphNamesOfType (ForAllTy _ ty) = orphNamesOfType ty
1203 orphNamesOfTypes :: [Type] -> NameSet
1204 orphNamesOfTypes tys = foldr (unionNameSets . orphNamesOfType) emptyNameSet tys
1206 orphNamesOfDFunHead :: Type -> NameSet
1207 -- Find the free type constructors and classes
1208 -- of the head of the dfun instance type
1209 -- The 'dfun_head_type' is because of
1210 -- instance Foo a => Baz T where ...
1211 -- The decl is an orphan if Baz and T are both not locally defined,
1212 -- even if Foo *is* locally defined
1213 orphNamesOfDFunHead dfun_ty
1214 = case tcSplitSigmaTy dfun_ty of
1215 (_, _, head_ty) -> orphNamesOfType head_ty
1219 %************************************************************************
1221 \subsection[TysWiredIn-ext-type]{External types}
1223 %************************************************************************
1225 The compiler's foreign function interface supports the passing of a
1226 restricted set of types as arguments and results (the restricting factor
1230 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
1231 -- (isIOType t) returns Just (IO,t',co)
1232 -- if co : t ~ IO t'
1233 -- returns Nothing otherwise
1234 tcSplitIOType_maybe ty
1235 = case tcSplitTyConApp_maybe ty of
1236 -- This split absolutely has to be a tcSplit, because we must
1237 -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
1239 Just (io_tycon, [io_res_ty])
1240 | io_tycon `hasKey` ioTyConKey
1241 -> Just (io_tycon, io_res_ty, IdCo ty)
1244 | not (isRecursiveTyCon tc)
1245 , Just (ty, co1) <- instNewTyCon_maybe tc tys
1246 -- Newtypes that require a coercion are ok
1247 -> case tcSplitIOType_maybe ty of
1249 Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
1253 isFFITy :: Type -> Bool
1254 -- True for any TyCon that can possibly be an arg or result of an FFI call
1255 isFFITy ty = checkRepTyCon legalFFITyCon ty
1257 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1258 -- Checks for valid argument type for a 'foreign import'
1259 isFFIArgumentTy dflags safety ty
1260 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1262 isFFIExternalTy :: Type -> Bool
1263 -- Types that are allowed as arguments of a 'foreign export'
1264 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1266 isFFIImportResultTy :: DynFlags -> Type -> Bool
1267 isFFIImportResultTy dflags ty
1268 = checkRepTyCon (legalFIResultTyCon dflags) ty
1270 isFFIExportResultTy :: Type -> Bool
1271 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1273 isFFIDynArgumentTy :: Type -> Bool
1274 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
1275 -- or a newtype of either.
1276 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1278 isFFIDynResultTy :: Type -> Bool
1279 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
1280 -- or a newtype of either.
1281 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1283 isFFILabelTy :: Type -> Bool
1284 -- The type of a foreign label must be Ptr, FunPtr, Addr,
1285 -- or a newtype of either.
1286 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1288 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1289 -- Checks for valid argument type for a 'foreign import prim'
1290 -- Currently they must all be simple unlifted types.
1291 isFFIPrimArgumentTy dflags ty
1292 = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1294 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1295 -- Checks for valid result type for a 'foreign import prim'
1296 -- Currently it must be an unlifted type, including unboxed tuples.
1297 isFFIPrimResultTy dflags ty
1298 = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1300 isFFIDotnetTy :: DynFlags -> Type -> Bool
1301 isFFIDotnetTy dflags ty
1302 = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
1303 isFFIDotnetObjTy ty || isStringTy ty)) ty
1304 -- NB: isStringTy used to look through newtypes, but
1305 -- it no longer does so. May need to adjust isFFIDotNetTy
1306 -- if we do want to look through newtypes.
1308 isFFIDotnetObjTy :: Type -> Bool
1310 = checkRepTyCon check_tc t_ty
1312 (_, t_ty) = tcSplitForAllTys ty
1313 check_tc tc = getName tc == objectTyConName
1315 isFunPtrTy :: Type -> Bool
1316 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1318 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1319 -- Look through newtypes, but *not* foralls
1320 -- Should work even for recursive newtypes
1321 -- eg Manuel had: newtype T = MkT (Ptr T)
1322 checkRepTyCon check_tc ty
1326 | Just (tc,tys) <- splitTyConApp_maybe ty
1327 = case carefullySplitNewType_maybe rec_nts tc tys of
1328 Just (rec_nts', ty') -> go rec_nts' ty'
1329 Nothing -> check_tc tc
1333 checkRepTyConKey :: [Unique] -> Type -> Bool
1334 -- Like checkRepTyCon, but just looks at the TyCon key
1335 checkRepTyConKey keys
1336 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1339 ----------------------------------------------
1340 These chaps do the work; they are not exported
1341 ----------------------------------------------
1344 legalFEArgTyCon :: TyCon -> Bool
1346 -- It's illegal to make foreign exports that take unboxed
1347 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
1348 = boxedMarshalableTyCon tc
1350 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1351 legalFIResultTyCon dflags tc
1352 | tc == unitTyCon = True
1353 | otherwise = marshalableTyCon dflags tc
1355 legalFEResultTyCon :: TyCon -> Bool
1356 legalFEResultTyCon tc
1357 | tc == unitTyCon = True
1358 | otherwise = boxedMarshalableTyCon tc
1360 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1361 -- Checks validity of types going from Haskell -> external world
1362 legalOutgoingTyCon dflags _ tc
1363 = marshalableTyCon dflags tc
1365 legalFFITyCon :: TyCon -> Bool
1366 -- True for any TyCon that can possibly be an arg or result of an FFI call
1368 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1370 marshalableTyCon :: DynFlags -> TyCon -> Bool
1371 marshalableTyCon dflags tc
1372 = (xopt Opt_UnliftedFFITypes dflags
1373 && isUnLiftedTyCon tc
1374 && not (isUnboxedTupleTyCon tc)
1375 && case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1378 || boxedMarshalableTyCon tc
1380 boxedMarshalableTyCon :: TyCon -> Bool
1381 boxedMarshalableTyCon tc
1382 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1383 , int32TyConKey, int64TyConKey
1384 , wordTyConKey, word8TyConKey, word16TyConKey
1385 , word32TyConKey, word64TyConKey
1386 , floatTyConKey, doubleTyConKey
1387 , ptrTyConKey, funPtrTyConKey
1393 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1394 -- Check args of 'foreign import prim', only allow simple unlifted types.
1395 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1396 -- currently they're of the wrong kind to use in function args anyway.
1397 legalFIPrimArgTyCon dflags tc
1398 = xopt Opt_UnliftedFFITypes dflags
1399 && isUnLiftedTyCon tc
1400 && not (isUnboxedTupleTyCon tc)
1402 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1403 -- Check result type of 'foreign import prim'. Allow simple unlifted
1404 -- types and also unboxed tuple result types '... -> (# , , #)'
1405 legalFIPrimResultTyCon dflags tc
1406 = xopt Opt_UnliftedFFITypes dflags
1407 && isUnLiftedTyCon tc
1408 && (isUnboxedTupleTyCon tc
1409 || case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1414 Note [Marshalling VoidRep]
1415 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1416 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1417 In turn that means you can't write
1418 foreign import foo :: Int -> State# RealWorld
1420 Reason: the back end falls over with panic "primRepHint:VoidRep";
1421 and there is no compelling reason to permit it