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 tyClsNamesOfType, tyClsNamesOfDFunHead,
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 tyClsNamesOfType :: Type -> NameSet
1189 tyClsNamesOfType (TyVarTy _) = emptyNameSet
1190 tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
1191 tyClsNamesOfType (PredTy (IParam _ ty)) = tyClsNamesOfType ty
1192 tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
1193 tyClsNamesOfType (PredTy (EqPred ty1 ty2)) = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2
1194 tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
1195 tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
1196 tyClsNamesOfType (ForAllTy _ ty) = tyClsNamesOfType ty
1198 tyClsNamesOfTypes :: [Type] -> NameSet
1199 tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
1201 tyClsNamesOfDFunHead :: Type -> NameSet
1202 -- Find the free type constructors and classes
1203 -- of the head of the dfun instance type
1204 -- The 'dfun_head_type' is because of
1205 -- instance Foo a => Baz T where ...
1206 -- The decl is an orphan if Baz and T are both not locally defined,
1207 -- even if Foo *is* locally defined
1208 tyClsNamesOfDFunHead dfun_ty
1209 = case tcSplitSigmaTy dfun_ty of
1210 (_, _, head_ty) -> tyClsNamesOfType head_ty
1214 %************************************************************************
1216 \subsection[TysWiredIn-ext-type]{External types}
1218 %************************************************************************
1220 The compiler's foreign function interface supports the passing of a
1221 restricted set of types as arguments and results (the restricting factor
1225 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
1226 -- (isIOType t) returns Just (IO,t',co)
1227 -- if co : t ~ IO t'
1228 -- returns Nothing otherwise
1229 tcSplitIOType_maybe ty
1230 = case tcSplitTyConApp_maybe ty of
1231 -- This split absolutely has to be a tcSplit, because we must
1232 -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
1234 Just (io_tycon, [io_res_ty])
1235 | io_tycon `hasKey` ioTyConKey
1236 -> Just (io_tycon, io_res_ty, IdCo ty)
1239 | not (isRecursiveTyCon tc)
1240 , Just (ty, co1) <- instNewTyCon_maybe tc tys
1241 -- Newtypes that require a coercion are ok
1242 -> case tcSplitIOType_maybe ty of
1244 Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
1248 isFFITy :: Type -> Bool
1249 -- True for any TyCon that can possibly be an arg or result of an FFI call
1250 isFFITy ty = checkRepTyCon legalFFITyCon ty
1252 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1253 -- Checks for valid argument type for a 'foreign import'
1254 isFFIArgumentTy dflags safety ty
1255 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1257 isFFIExternalTy :: Type -> Bool
1258 -- Types that are allowed as arguments of a 'foreign export'
1259 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1261 isFFIImportResultTy :: DynFlags -> Type -> Bool
1262 isFFIImportResultTy dflags ty
1263 = checkRepTyCon (legalFIResultTyCon dflags) ty
1265 isFFIExportResultTy :: Type -> Bool
1266 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1268 isFFIDynArgumentTy :: Type -> Bool
1269 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
1270 -- or a newtype of either.
1271 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1273 isFFIDynResultTy :: Type -> Bool
1274 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
1275 -- or a newtype of either.
1276 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1278 isFFILabelTy :: Type -> Bool
1279 -- The type of a foreign label must be Ptr, FunPtr, Addr,
1280 -- or a newtype of either.
1281 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1283 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1284 -- Checks for valid argument type for a 'foreign import prim'
1285 -- Currently they must all be simple unlifted types.
1286 isFFIPrimArgumentTy dflags ty
1287 = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1289 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1290 -- Checks for valid result type for a 'foreign import prim'
1291 -- Currently it must be an unlifted type, including unboxed tuples.
1292 isFFIPrimResultTy dflags ty
1293 = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1295 isFFIDotnetTy :: DynFlags -> Type -> Bool
1296 isFFIDotnetTy dflags ty
1297 = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
1298 isFFIDotnetObjTy ty || isStringTy ty)) ty
1299 -- NB: isStringTy used to look through newtypes, but
1300 -- it no longer does so. May need to adjust isFFIDotNetTy
1301 -- if we do want to look through newtypes.
1303 isFFIDotnetObjTy :: Type -> Bool
1305 = checkRepTyCon check_tc t_ty
1307 (_, t_ty) = tcSplitForAllTys ty
1308 check_tc tc = getName tc == objectTyConName
1310 isFunPtrTy :: Type -> Bool
1311 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1313 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1314 -- Look through newtypes, but *not* foralls
1315 -- Should work even for recursive newtypes
1316 -- eg Manuel had: newtype T = MkT (Ptr T)
1317 checkRepTyCon check_tc ty
1321 | Just (tc,tys) <- splitTyConApp_maybe ty
1322 = case carefullySplitNewType_maybe rec_nts tc tys of
1323 Just (rec_nts', ty') -> go rec_nts' ty'
1324 Nothing -> check_tc tc
1328 checkRepTyConKey :: [Unique] -> Type -> Bool
1329 -- Like checkRepTyCon, but just looks at the TyCon key
1330 checkRepTyConKey keys
1331 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1334 ----------------------------------------------
1335 These chaps do the work; they are not exported
1336 ----------------------------------------------
1339 legalFEArgTyCon :: TyCon -> Bool
1341 -- It's illegal to make foreign exports that take unboxed
1342 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
1343 = boxedMarshalableTyCon tc
1345 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1346 legalFIResultTyCon dflags tc
1347 | tc == unitTyCon = True
1348 | otherwise = marshalableTyCon dflags tc
1350 legalFEResultTyCon :: TyCon -> Bool
1351 legalFEResultTyCon tc
1352 | tc == unitTyCon = True
1353 | otherwise = boxedMarshalableTyCon tc
1355 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1356 -- Checks validity of types going from Haskell -> external world
1357 legalOutgoingTyCon dflags _ tc
1358 = marshalableTyCon dflags tc
1360 legalFFITyCon :: TyCon -> Bool
1361 -- True for any TyCon that can possibly be an arg or result of an FFI call
1363 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1365 marshalableTyCon :: DynFlags -> TyCon -> Bool
1366 marshalableTyCon dflags tc
1367 = (xopt Opt_UnliftedFFITypes dflags
1368 && isUnLiftedTyCon tc
1369 && not (isUnboxedTupleTyCon tc)
1370 && case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1373 || boxedMarshalableTyCon tc
1375 boxedMarshalableTyCon :: TyCon -> Bool
1376 boxedMarshalableTyCon tc
1377 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1378 , int32TyConKey, int64TyConKey
1379 , wordTyConKey, word8TyConKey, word16TyConKey
1380 , word32TyConKey, word64TyConKey
1381 , floatTyConKey, doubleTyConKey
1382 , ptrTyConKey, funPtrTyConKey
1388 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1389 -- Check args of 'foreign import prim', only allow simple unlifted types.
1390 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1391 -- currently they're of the wrong kind to use in function args anyway.
1392 legalFIPrimArgTyCon dflags tc
1393 = xopt Opt_UnliftedFFITypes dflags
1394 && isUnLiftedTyCon tc
1395 && not (isUnboxedTupleTyCon tc)
1397 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1398 -- Check result type of 'foreign import prim'. Allow simple unlifted
1399 -- types and also unboxed tuple result types '... -> (# , , #)'
1400 legalFIPrimResultTyCon dflags tc
1401 = xopt Opt_UnliftedFFITypes dflags
1402 && isUnLiftedTyCon tc
1403 && (isUnboxedTupleTyCon tc
1404 || case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1409 Note [Marshalling VoidRep]
1410 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1411 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1412 In turn that means you can't write
1413 foreign import foo :: Int -> State# RealWorld
1415 Reason: the back end falls over with panic "primRepHint:VoidRep";
1416 and there is no compelling reason to permit it