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,
24 BoxyTyVar, BoxySigmaType, BoxyRhoType, BoxyThetaType, BoxyType,
26 --------------------------------
28 UserTypeCtxt(..), pprUserTypeCtxt,
29 TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails,
30 MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
31 isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar,
32 isSigTyVar, isExistentialTyVar, isTyConableTyVar,
34 isFlexi, isIndirect, isRuntimeUnk, isUnk,
36 --------------------------------
40 --------------------------------
42 -- These are important because they do not look through newtypes
44 tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
45 tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
46 tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
47 tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
48 tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
49 tcGetTyVar_maybe, tcGetTyVar,
50 tcSplitSigmaTy, tcMultiSplitSigmaTy,
52 ---------------------------------
54 -- Again, newtypes are opaque
55 tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
57 isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
58 isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
59 isIntegerTy, isBoolTy, isUnitTy, isCharTy,
60 isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
63 ---------------------------------
64 -- Misc type manipulators
66 tyClsNamesOfType, tyClsNamesOfDFunHead,
69 ---------------------------------
71 getClassPredTys_maybe, getClassPredTys,
72 isClassPred, isTyVarClassPred, isEqPred,
73 mkDictTy, tcSplitPredTy_maybe,
74 isPredTy, isDictTy, isDictLikeTy,
75 tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
76 mkClassPred, isInheritablePred, isIPPred,
77 isRefineableTy, isRefineablePred,
79 ---------------------------------
80 -- Foreign import and export
81 isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
82 isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
83 isFFIExportResultTy, -- :: Type -> Bool
84 isFFIExternalTy, -- :: Type -> Bool
85 isFFIDynArgumentTy, -- :: Type -> Bool
86 isFFIDynResultTy, -- :: Type -> Bool
87 isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
88 isFFIPrimResultTy, -- :: DynFlags -> Type -> Bool
89 isFFILabelTy, -- :: Type -> Bool
90 isFFIDotnetTy, -- :: DynFlags -> Type -> Bool
91 isFFIDotnetObjTy, -- :: Type -> Bool
92 isFFITy, -- :: Type -> Bool
93 isFunPtrTy, -- :: Type -> Bool
94 tcSplitIOType_maybe, -- :: Type -> Maybe Type
96 --------------------------------
97 -- Rexported from Type
98 Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
99 unliftedTypeKind, liftedTypeKind, argTypeKind,
100 openTypeKind, mkArrowKind, mkArrowKinds,
101 isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
102 isSubArgTypeKind, isSubKind, splitKindFunTys, defaultKind,
103 kindVarRef, mkKindVar,
105 Type, PredType(..), ThetaType,
106 mkForAllTy, mkForAllTys,
107 mkFunTy, mkFunTys, zipFunTys,
108 mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
109 mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys,
111 -- Type substitutions
112 TvSubst(..), -- Representation visible to a few friends
113 TvSubstEnv, emptyTvSubst, substEqSpec,
114 mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
115 getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
116 extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
117 substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, substTyVarBndr,
119 isUnLiftedType, -- Source types are always lifted
120 isUnboxedTupleType, -- Ditto
123 tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
124 tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, tidySkolemTyVar,
127 tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
128 tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
131 pprKind, pprParendKind,
132 pprType, pprParendType, pprTypeApp, pprTyThingCategory,
133 pprPred, pprTheta, pprThetaArrow, pprClassPred
137 #include "HsVersions.h"
167 %************************************************************************
171 %************************************************************************
173 The type checker divides the generic Type world into the
174 following more structured beasts:
176 sigma ::= forall tyvars. phi
177 -- A sigma type is a qualified type
179 -- Note that even if 'tyvars' is empty, theta
180 -- may not be: e.g. (?x::Int) => Int
182 -- Note that 'sigma' is in prenex form:
183 -- all the foralls are at the front.
184 -- A 'phi' type has no foralls to the right of
192 -- A 'tau' type has no quantification anywhere
193 -- Note that the args of a type constructor must be taus
195 | tycon tau_1 .. tau_n
199 -- In all cases, a (saturated) type synonym application is legal,
200 -- provided it expands to the required form.
203 type TcTyVar = TyVar -- Used only during type inference
204 type TcType = Type -- A TcType can have mutable type variables
205 -- Invariant on ForAllTy in TcTypes:
207 -- a cannot occur inside a MutTyVar in T; that is,
208 -- T is "flattened" before quantifying over a
210 -- These types do not have boxy type variables in them
211 type TcPredType = PredType
212 type TcThetaType = ThetaType
213 type TcSigmaType = TcType
214 type TcRhoType = TcType
215 type TcTauType = TcType
217 type TcTyVarSet = TyVarSet
219 -- These types may have boxy type variables in them
220 type BoxyTyVar = TcTyVar
221 type BoxyRhoType = TcType
222 type BoxyThetaType = TcThetaType
223 type BoxySigmaType = TcType
224 type BoxyType = TcType
228 %************************************************************************
230 \subsection{TyVarDetails}
232 %************************************************************************
234 TyVarDetails gives extra info about type variables, used during type
235 checking. It's attached to mutable type variables only.
236 It's knot-tied back to Var.lhs. There is no reason in principle
237 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
240 Note [Signature skolems]
241 ~~~~~~~~~~~~~~~~~~~~~~~~
246 (x,y,z) = ([y,z], z, head x)
248 Here, x and y have type sigs, which go into the environment. We used to
249 instantiate their types with skolem constants, and push those types into
250 the RHS, so we'd typecheck the RHS with type
252 where a*, b* are skolem constants, and c is an ordinary meta type varible.
254 The trouble is that the occurrences of z in the RHS force a* and b* to
255 be the *same*, so we can't make them into skolem constants that don't unify
256 with each other. Alas.
258 One solution would be insist that in the above defn the programmer uses
259 the same type variable in both type signatures. But that takes explanation.
261 The alternative (currently implemented) is to have a special kind of skolem
262 constant, SigTv, which can unify with other SigTvs. These are *not* treated
263 as righd for the purposes of GADTs. And they are used *only* for pattern
264 bindings and mutually recursive function bindings. See the function
265 TcBinds.tcInstSig, and its use_skols parameter.
269 -- A TyVarDetails is inside a TyVar
271 = SkolemTv SkolemInfo -- A skolem constant
273 | MetaTv BoxInfo (IORef MetaDetails)
276 = BoxTv -- The contents is a (non-boxy) sigma-type
277 -- That is, this MetaTv is a "box"
279 | TauTv -- The contents is a (non-boxy) tau-type
280 -- That is, this MetaTv is an ordinary unification variable
282 | SigTv SkolemInfo -- A variant of TauTv, except that it should not be
283 -- unified with a type, only with a type variable
284 -- SigTvs are only distinguished to improve error messages
285 -- see Note [Signature skolems]
286 -- The MetaDetails, if filled in, will
287 -- always be another SigTv or a SkolemTv
290 -- A TauTv is always filled in with a tau-type, which
291 -- never contains any BoxTvs, nor any ForAlls
293 -- However, a BoxTv can contain a type that contains further BoxTvs
294 -- Notably, when typechecking an explicit list, say [e1,e2], with
295 -- expected type being a box b1, we fill in b1 with (List b2), where
296 -- b2 is another (currently empty) box.
299 = Flexi -- Flexi type variables unify to become
302 | Indirect TcType -- INVARIANT:
303 -- For a BoxTv, this type must be non-boxy
304 -- For a TauTv, this type must be a tau-type
306 -- Generally speaking, SkolemInfo should not contain location info
307 -- that is contained in the Name of the tyvar with this SkolemInfo
309 = SigSkol UserTypeCtxt -- A skolem that is created by instantiating
310 -- a programmer-supplied type signature
311 -- Location of the binding site is on the TyVar
313 -- The rest are for non-scoped skolems
314 | ClsSkol Class -- Bound at a class decl
315 | InstSkol -- Bound at an instance decl
316 | FamInstSkol -- Bound at a family instance decl
317 | PatSkol DataCon -- An existential type variable bound by a pattern for
318 -- a data constructor with an existential type. E.g.
319 -- data T = forall a. Eq a => MkT a
321 -- The pattern MkT x will allocate an existential type
323 | ArrowSkol -- An arrow form (see TcArrows)
325 | RuleSkol RuleName -- The LHS of a RULE
326 | GenSkol [TcTyVar] -- Bound when doing a subsumption check for
327 TcType -- (forall tvs. ty)
329 | RuntimeUnkSkol -- a type variable used to represent an unknown
330 -- runtime type (used in the GHCi debugger)
332 | UnkSkol -- Unhelpful info (until I improve it)
334 -------------------------------------
335 -- UserTypeCtxt describes the places where a
336 -- programmer-written type signature can occur
337 -- Like SkolemInfo, no location info
339 = FunSigCtxt Name -- Function type signature
340 -- Also used for types in SPECIALISE pragmas
341 | ExprSigCtxt -- Expression type signature
342 | ConArgCtxt Name -- Data constructor argument
343 | TySynCtxt Name -- RHS of a type synonym decl
344 | GenPatCtxt -- Pattern in generic decl
345 -- f{| a+b |} (Inl x) = ...
346 | LamPatSigCtxt -- Type sig in lambda pattern
348 | BindPatSigCtxt -- Type sig in pattern binding pattern
350 | ResSigCtxt -- Result type sig
352 | ForSigCtxt Name -- Foreign inport or export signature
353 | DefaultDeclCtxt -- Types in a default declaration
354 | SpecInstCtxt -- SPECIALISE instance pragma
355 | ThBrackCtxt -- Template Haskell type brackets [t| ... |]
357 -- Notes re TySynCtxt
358 -- We allow type synonyms that aren't types; e.g. type List = []
360 -- If the RHS mentions tyvars that aren't in scope, we'll
361 -- quantify over them:
362 -- e.g. type T = a->a
363 -- will become type T = forall a. a->a
365 -- With gla-exts that's right, but for H98 we should complain.
367 ---------------------------------
370 mkKindName :: Unique -> Name
371 mkKindName unique = mkSystemName unique kind_var_occ
373 kindVarRef :: KindVar -> IORef MetaDetails
375 ASSERT ( isTcTyVar tc )
376 case tcTyVarDetails tc of
377 MetaTv TauTv ref -> ref
378 _ -> pprPanic "kindVarRef" (ppr tc)
380 mkKindVar :: Unique -> IORef MetaDetails -> KindVar
382 = mkTcTyVar (mkKindName u)
383 tySuperKind -- not sure this is right,
384 -- do we need kind vars for
388 kind_var_occ :: OccName -- Just one for all KindVars
389 -- They may be jiggled by tidying
390 kind_var_occ = mkOccName tvName "k"
393 %************************************************************************
397 %************************************************************************
400 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
402 pprTcTyVarDetails (SkolemTv _) = ptext (sLit "sk")
403 pprTcTyVarDetails (MetaTv BoxTv _) = ptext (sLit "box")
404 pprTcTyVarDetails (MetaTv TauTv _) = ptext (sLit "tau")
405 pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
407 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
408 pprUserTypeCtxt (FunSigCtxt n) = ptext (sLit "the type signature for") <+> quotes (ppr n)
409 pprUserTypeCtxt ExprSigCtxt = ptext (sLit "an expression type signature")
410 pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
411 pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
412 pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition")
413 pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]")
414 pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature")
415 pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature")
416 pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature")
417 pprUserTypeCtxt (ForSigCtxt n) = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
418 pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
419 pprUserTypeCtxt SpecInstCtxt = ptext (sLit "a SPECIALISE instance pragma")
422 --------------------------------
423 tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
424 -- Tidy the type inside a GenSkol, preparatory to printing it
425 tidySkolemTyVar env tv
426 = ASSERT( isTcTyVar tv && (isSkolemTyVar tv || isSigTyVar tv ) )
427 (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
429 (env1, info1) = case tcTyVarDetails tv of
430 SkolemTv info -> (env1, SkolemTv info')
432 (env1, info') = tidy_skol_info env info
433 MetaTv (SigTv info) box -> (env1, MetaTv (SigTv info') box)
435 (env1, info') = tidy_skol_info env info
438 tidy_skol_info env (GenSkol tvs ty) = (env2, GenSkol tvs1 ty1)
440 (env1, tvs1) = tidyOpenTyVars env tvs
441 (env2, ty1) = tidyOpenType env1 ty
442 tidy_skol_info env info = (env, info)
444 pprSkolTvBinding :: TcTyVar -> SDoc
445 -- Print info about the binding of a skolem tyvar,
446 -- or nothing if we don't have anything useful to say
448 = ASSERT ( isTcTyVar tv )
449 quotes (ppr tv) <+> ppr_details (tcTyVarDetails tv)
451 ppr_details (MetaTv TauTv _) = ptext (sLit "is a meta type variable")
452 ppr_details (MetaTv BoxTv _) = ptext (sLit "is a boxy type variable")
453 ppr_details (MetaTv (SigTv info) _) = ppr_skol info
454 ppr_details (SkolemTv info) = ppr_skol info
456 ppr_skol UnkSkol = ptext (sLit "is an unknown type variable") -- Unhelpful
457 ppr_skol RuntimeUnkSkol = ptext (sLit "is an unknown runtime type")
458 ppr_skol info = sep [ptext (sLit "is a rigid type variable bound by"),
459 sep [pprSkolInfo info,
460 nest 2 (ptext (sLit "at") <+> ppr (getSrcLoc tv))]]
462 pprSkolInfo :: SkolemInfo -> SDoc
463 pprSkolInfo (SigSkol ctxt) = pprUserTypeCtxt ctxt
464 pprSkolInfo (ClsSkol cls) = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
465 pprSkolInfo InstSkol = ptext (sLit "the instance declaration")
466 pprSkolInfo FamInstSkol = ptext (sLit "the family instance declaration")
467 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
468 pprSkolInfo ArrowSkol = ptext (sLit "the arrow form")
469 pprSkolInfo (PatSkol dc) = sep [ptext (sLit "the constructor") <+> quotes (ppr dc)]
470 pprSkolInfo (GenSkol tvs ty) = sep [ptext (sLit "the polymorphic type"),
471 nest 2 (quotes (ppr (mkForAllTys tvs ty)))]
474 -- For type variables the others are dealt with by pprSkolTvBinding.
475 -- For Insts, these cases should not happen
476 pprSkolInfo UnkSkol = panic "UnkSkol"
477 pprSkolInfo RuntimeUnkSkol = panic "RuntimeUnkSkol"
479 instance Outputable MetaDetails where
480 ppr Flexi = ptext (sLit "Flexi")
481 ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
485 %************************************************************************
489 %************************************************************************
492 isImmutableTyVar :: TyVar -> Bool
495 | isTcTyVar tv = isSkolemTyVar tv
498 isTyConableTyVar, isSkolemTyVar, isExistentialTyVar,
499 isBoxyTyVar, isMetaTyVar :: TcTyVar -> Bool
502 -- True of a meta-type variable that can be filled in
503 -- with a type constructor application; in particular,
505 = ASSERT( isTcTyVar tv)
506 case tcTyVarDetails tv of
507 MetaTv BoxTv _ -> True
508 MetaTv TauTv _ -> True
509 MetaTv (SigTv {}) _ -> False
513 = ASSERT2( isTcTyVar tv, ppr tv )
514 case tcTyVarDetails tv of
518 isExistentialTyVar tv -- Existential type variable, bound by a pattern
519 = ASSERT( isTcTyVar tv )
520 case tcTyVarDetails tv of
521 SkolemTv (PatSkol {}) -> True
525 = ASSERT2( isTcTyVar tv, ppr tv )
526 case tcTyVarDetails tv of
531 = ASSERT( isTcTyVar tv )
532 case tcTyVarDetails tv of
533 MetaTv BoxTv _ -> True
536 isSigTyVar :: Var -> Bool
538 = ASSERT( isTcTyVar tv )
539 case tcTyVarDetails tv of
540 MetaTv (SigTv _) _ -> True
543 metaTvRef :: TyVar -> IORef MetaDetails
545 = ASSERT2( isTcTyVar tv, ppr tv )
546 case tcTyVarDetails tv of
548 _ -> pprPanic "metaTvRef" (ppr tv)
550 isFlexi, isIndirect :: MetaDetails -> Bool
554 isIndirect (Indirect _) = True
557 isRuntimeUnk :: TyVar -> Bool
558 isRuntimeUnk x | isTcTyVar x
559 , SkolemTv RuntimeUnkSkol <- tcTyVarDetails x = True
562 isUnk :: TyVar -> Bool
563 isUnk x | isTcTyVar x
564 , SkolemTv UnkSkol <- tcTyVarDetails x = True
569 %************************************************************************
571 \subsection{Tau, sigma and rho}
573 %************************************************************************
576 mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
577 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
579 mkPhiTy :: [PredType] -> Type -> Type
580 mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
583 @isTauTy@ tests for nested for-alls. It should not be called on a boxy type.
586 isTauTy :: Type -> Bool
587 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
588 isTauTy (TyVarTy tv) = ASSERT( not (isTcTyVar tv && isBoxyTyVar tv) )
590 isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
591 isTauTy (AppTy a b) = isTauTy a && isTauTy b
592 isTauTy (FunTy a b) = isTauTy a && isTauTy b
593 isTauTy (PredTy _) = True -- Don't look through source types
597 isTauTyCon :: TyCon -> Bool
598 -- Returns False for type synonyms whose expansion is a polytype
600 | isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
604 isBoxyTy :: TcType -> Bool
605 isBoxyTy ty = any isBoxyTyVar (varSetElems (tcTyVarsOfType ty))
607 isRigidTy :: TcType -> Bool
608 -- A type is rigid if it has no meta type variables in it
609 isRigidTy ty = all isImmutableTyVar (varSetElems (tcTyVarsOfType ty))
611 isRefineableTy :: TcType -> (Bool,Bool)
612 -- A type should have type refinements applied to it if it has
613 -- free type variables, and they are all rigid
614 isRefineableTy ty = (null tc_tvs, all isImmutableTyVar tc_tvs)
616 tc_tvs = varSetElems (tcTyVarsOfType ty)
618 isRefineablePred :: TcPredType -> Bool
619 isRefineablePred pred = not (null tc_tvs) && all isImmutableTyVar tc_tvs
621 tc_tvs = varSetElems (tcTyVarsOfPred pred)
624 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
625 -- construct a dictionary function name
626 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
627 getDFunTyKey (TyVarTy tv) = getOccName tv
628 getDFunTyKey (TyConApp tc _) = getOccName tc
629 getDFunTyKey (AppTy fun _) = getDFunTyKey fun
630 getDFunTyKey (FunTy _ _) = getOccName funTyCon
631 getDFunTyKey (ForAllTy _ t) = getDFunTyKey t
632 getDFunTyKey ty = pprPanic "getDFunTyKey" (pprType ty)
633 -- PredTy shouldn't happen
637 %************************************************************************
639 \subsection{Expanding and splitting}
641 %************************************************************************
643 These tcSplit functions are like their non-Tc analogues, but
644 a) they do not look through newtypes
645 b) they do not look through PredTys
647 However, they are non-monadic and do not follow through mutable type
648 variables. It's up to you to make sure this doesn't matter.
651 tcSplitForAllTys :: Type -> ([TyVar], Type)
652 tcSplitForAllTys ty = split ty ty []
654 split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
655 split _ (ForAllTy tv ty) tvs
656 | not (isCoVar tv) = split ty ty (tv:tvs)
657 split orig_ty _ tvs = (reverse tvs, orig_ty)
659 tcIsForAllTy :: Type -> Bool
660 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
661 tcIsForAllTy (ForAllTy tv _) = not (isCoVar tv)
662 tcIsForAllTy _ = False
664 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
665 -- Split off the first predicate argument from a type
666 tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
667 tcSplitPredFunTy_maybe (ForAllTy tv ty)
668 | isCoVar tv = Just (coVarPred tv, ty)
669 tcSplitPredFunTy_maybe (FunTy arg res)
670 | Just p <- tcSplitPredTy_maybe arg = Just (p, res)
671 tcSplitPredFunTy_maybe _
674 tcSplitPhiTy :: Type -> (ThetaType, Type)
679 = case tcSplitPredFunTy_maybe ty of
680 Just (pred, ty) -> split ty (pred:ts)
681 Nothing -> (reverse ts, ty)
683 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
684 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
685 (tvs, rho) -> case tcSplitPhiTy rho of
686 (theta, tau) -> (tvs, theta, tau)
688 -----------------------
691 -> ( [([TyVar], ThetaType)], -- forall as.C => forall bs.D
692 TcSigmaType) -- The rest of the type
694 -- We need a loop here because we are now prepared to entertain
696 -- f:: forall a. Eq a => forall b. Baz b => tau
697 -- We want to instantiate this to
698 -- f2::tau {f2 = f1 b (Baz b), f1 = f a (Eq a)}
700 tcMultiSplitSigmaTy sigma
701 = case (tcSplitSigmaTy sigma) of
702 ([], [], _) -> ([], sigma)
703 (tvs, theta, ty) -> case tcMultiSplitSigmaTy ty of
704 (pairs, rest) -> ((tvs,theta):pairs, rest)
706 -----------------------
707 tcTyConAppTyCon :: Type -> TyCon
708 tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
710 Nothing -> pprPanic "tcTyConAppTyCon" (pprType ty)
712 tcTyConAppArgs :: Type -> [Type]
713 tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
714 Just (_, args) -> args
715 Nothing -> pprPanic "tcTyConAppArgs" (pprType ty)
717 tcSplitTyConApp :: Type -> (TyCon, [Type])
718 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
720 Nothing -> pprPanic "tcSplitTyConApp" (pprType ty)
722 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
723 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
724 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
725 tcSplitTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res])
726 -- Newtypes are opaque, so they may be split
727 -- However, predicates are not treated
728 -- as tycon applications by the type checker
729 tcSplitTyConApp_maybe _ = Nothing
731 -----------------------
732 tcSplitFunTys :: Type -> ([Type], Type)
733 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
735 Just (arg,res) -> (arg:args, res')
737 (args,res') = tcSplitFunTys res
739 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
740 tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
741 tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
742 tcSplitFunTy_maybe _ = Nothing
743 -- Note the (not (isPredTy arg)) guard
744 -- Consider (?x::Int) => Bool
745 -- We don't want to treat this as a function type!
746 -- A concrete example is test tc230:
747 -- f :: () -> (?p :: ()) => () -> ()
753 -> Arity -- N: Number of desired args
754 -> ([TcSigmaType], -- Arg types (N or fewer)
755 TcSigmaType) -- The rest of the type
757 tcSplitFunTysN ty n_args
760 | Just (arg,res) <- tcSplitFunTy_maybe ty
761 = case tcSplitFunTysN res (n_args - 1) of
762 (args, res) -> (arg:args, res)
766 tcSplitFunTy :: Type -> (Type, Type)
767 tcSplitFunTy ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
769 tcFunArgTy :: Type -> Type
770 tcFunArgTy ty = fst (tcSplitFunTy ty)
772 tcFunResultTy :: Type -> Type
773 tcFunResultTy ty = snd (tcSplitFunTy ty)
775 -----------------------
776 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
777 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
778 tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
780 tcSplitAppTy :: Type -> (Type, Type)
781 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
783 Nothing -> pprPanic "tcSplitAppTy" (pprType ty)
785 tcSplitAppTys :: Type -> (Type, [Type])
789 go ty args = case tcSplitAppTy_maybe ty of
790 Just (ty', arg) -> go ty' (arg:args)
793 -----------------------
794 tcGetTyVar_maybe :: Type -> Maybe TyVar
795 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
796 tcGetTyVar_maybe (TyVarTy tv) = Just tv
797 tcGetTyVar_maybe _ = Nothing
799 tcGetTyVar :: String -> Type -> TyVar
800 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
802 tcIsTyVarTy :: Type -> Bool
803 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
805 -----------------------
806 tcSplitDFunTy :: Type -> ([TyVar], Class, [Type])
807 -- Split the type of a dictionary function
808 -- We don't use tcSplitSigmaTy, because a DFun may (with NDP)
809 -- have non-Pred arguments, such as
810 -- df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
812 = case tcSplitForAllTys ty of { (tvs, rho) ->
813 case tcSplitDFunHead (drop_pred_tys rho) of { (clas, tys) ->
816 -- Discard the context of the dfun. This can be a mix of
817 -- coercion and class constraints; or (in the general NDP case)
818 -- some other function argument
819 drop_pred_tys ty | Just ty' <- tcView ty = drop_pred_tys ty'
820 drop_pred_tys (ForAllTy tv ty) = ASSERT( isCoVar tv ) drop_pred_tys ty
821 drop_pred_tys (FunTy _ ty) = drop_pred_tys ty
822 drop_pred_tys ty = ty
824 tcSplitDFunHead :: Type -> (Class, [Type])
826 = case tcSplitPredTy_maybe tau of
827 Just (ClassP clas tys) -> (clas, tys)
828 _ -> pprPanic "tcSplitDFunHead" (ppr tau)
830 tcInstHeadTyNotSynonym :: Type -> Bool
831 -- Used in Haskell-98 mode, for the argument types of an instance head
832 -- These must not be type synonyms, but everywhere else type synonyms
833 -- are transparent, so we need a special function here
834 tcInstHeadTyNotSynonym ty
836 TyConApp tc _ -> not (isSynTyCon tc)
839 tcInstHeadTyAppAllTyVars :: Type -> Bool
840 -- Used in Haskell-98 mode, for the argument types of an instance head
841 -- These must be a constructor applied to type variable arguments
842 tcInstHeadTyAppAllTyVars ty
844 TyConApp _ tys -> ok tys
845 FunTy arg res -> ok [arg, res]
848 -- Check that all the types are type variables,
849 -- and that each is distinct
850 ok tys = equalLength tvs tys && hasNoDups tvs
852 tvs = mapCatMaybes get_tv tys
854 get_tv (TyVarTy tv) = Just tv -- through synonyms
860 %************************************************************************
862 \subsection{Predicate types}
864 %************************************************************************
867 tcSplitPredTy_maybe :: Type -> Maybe PredType
868 -- Returns Just for predicates only
869 tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
870 tcSplitPredTy_maybe (PredTy p) = Just p
871 tcSplitPredTy_maybe _ = Nothing
873 predTyUnique :: PredType -> Unique
874 predTyUnique (IParam n _) = getUnique (ipNameName n)
875 predTyUnique (ClassP clas _) = getUnique clas
876 predTyUnique (EqPred a b) = pprPanic "predTyUnique" (ppr (EqPred a b))
880 --------------------- Dictionary types ---------------------------------
883 mkClassPred :: Class -> [Type] -> PredType
884 mkClassPred clas tys = ClassP clas tys
886 isClassPred :: PredType -> Bool
887 isClassPred (ClassP _ _) = True
888 isClassPred _ = False
890 isTyVarClassPred :: PredType -> Bool
891 isTyVarClassPred (ClassP _ tys) = all tcIsTyVarTy tys
892 isTyVarClassPred _ = False
894 getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
895 getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
896 getClassPredTys_maybe _ = Nothing
898 getClassPredTys :: PredType -> (Class, [Type])
899 getClassPredTys (ClassP clas tys) = (clas, tys)
900 getClassPredTys _ = panic "getClassPredTys"
902 mkDictTy :: Class -> [Type] -> Type
903 mkDictTy clas tys = mkPredTy (ClassP clas tys)
905 isDictLikeTy :: Type -> Bool
906 -- Note [Dictionary-like types]
907 isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'
908 isDictLikeTy (PredTy p) = isClassPred p
909 isDictLikeTy (TyConApp tc tys)
910 | isTupleTyCon tc = all isDictLikeTy tys
911 isDictLikeTy _ = False
914 Note [Dictionary-like types]
915 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
916 Being "dictionary-like" means either a dictionary type or a tuple thereof.
917 In GHC 6.10 we build implication constraints which construct such tuples,
918 and if we land up with a binding
921 then we want to treat t as cheap under "-fdicts-cheap" for example.
922 (Implication constraints are normally inlined, but sadly not if the
923 occurrence is itself inside an INLINE function! Until we revise the
924 handling of implication constraints, that is.) This turned out to
925 be important in getting good arities in DPH code. Example:
928 class D a where { foo :: a -> a }
929 instance C a => D (Maybe a) where { foo x = x }
931 bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
933 bar x y = (foo (Just x), foo (Just y))
935 Then 'bar' should jolly well have arity 4 (two dicts, two args), but
936 we ended up with something like
937 bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
940 This is all a bit ad-hoc; eg it relies on knowing that implication
941 constraints build tuples.
943 --------------------- Implicit parameters ---------------------------------
946 isIPPred :: PredType -> Bool
947 isIPPred (IParam _ _) = True
950 isInheritablePred :: PredType -> Bool
951 -- Can be inherited by a context. For example, consider
952 -- f x = let g y = (?v, y+x)
953 -- in (g 3 with ?v = 8,
955 -- The point is that g's type must be quantifed over ?v:
956 -- g :: (?v :: a) => a -> a
957 -- but it doesn't need to be quantified over the Num a dictionary
958 -- which can be free in g's rhs, and shared by both calls to g
959 isInheritablePred (ClassP _ _) = True
960 isInheritablePred (EqPred _ _) = True
961 isInheritablePred _ = False
964 --------------------- Equality predicates ---------------------------------
966 substEqSpec :: TvSubst -> [(TyVar,Type)] -> [(TcType,TcType)]
967 substEqSpec subst eq_spec = [ (substTyVar subst tv, substTy subst ty)
968 | (tv,ty) <- eq_spec]
972 %************************************************************************
974 \subsection{Predicates}
976 %************************************************************************
978 isSigmaTy returns true of any qualified type. It doesn't *necessarily* have
980 f :: (?x::Int) => Int -> Int
983 isSigmaTy :: Type -> Bool
984 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
985 isSigmaTy (ForAllTy _ _) = True
986 isSigmaTy (FunTy a _) = isPredTy a
989 isOverloadedTy :: Type -> Bool
990 -- Yes for a type of a function that might require evidence-passing
991 -- Used only by bindInstsOfLocalFuns/Pats
992 -- NB: be sure to check for type with an equality predicate; hence isCoVar
993 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
994 isOverloadedTy (ForAllTy tv ty) = isCoVar tv || isOverloadedTy ty
995 isOverloadedTy (FunTy a _) = isPredTy a
996 isOverloadedTy _ = False
998 isPredTy :: Type -> Bool -- Belongs in TcType because it does
999 -- not look through newtypes, or predtypes (of course)
1000 isPredTy ty | Just ty' <- tcView ty = isPredTy ty'
1001 isPredTy (PredTy _) = True
1006 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
1007 isUnitTy, isCharTy :: Type -> Bool
1008 isFloatTy = is_tc floatTyConKey
1009 isDoubleTy = is_tc doubleTyConKey
1010 isIntegerTy = is_tc integerTyConKey
1011 isIntTy = is_tc intTyConKey
1012 isWordTy = is_tc wordTyConKey
1013 isBoolTy = is_tc boolTyConKey
1014 isUnitTy = is_tc unitTyConKey
1015 isCharTy = is_tc charTyConKey
1017 isStringTy :: Type -> Bool
1019 = case tcSplitTyConApp_maybe ty of
1020 Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
1023 is_tc :: Unique -> Type -> Bool
1024 -- Newtypes are opaque to this
1025 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
1026 Just (tc, _) -> uniq == getUnique tc
1031 -- NB: Currently used in places where we have already expanded type synonyms;
1032 -- hence no 'coreView'. This could, however, be changed without breaking
1034 isOpenSynTyConApp :: TcTauType -> Bool
1035 isOpenSynTyConApp (TyConApp tc tys) = isOpenSynTyCon tc &&
1036 length tys == tyConArity tc
1037 isOpenSynTyConApp _other = False
1041 %************************************************************************
1045 %************************************************************************
1048 deNoteType :: Type -> Type
1049 -- Remove all *outermost* type synonyms and other notes
1050 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
1055 tcTyVarsOfType :: Type -> TcTyVarSet
1056 -- Just the *TcTyVars* free in the type
1057 -- (Types.tyVarsOfTypes finds all free TyVars)
1058 tcTyVarsOfType (TyVarTy tv) = if isTcTyVar tv then unitVarSet tv
1060 tcTyVarsOfType (TyConApp _ tys) = tcTyVarsOfTypes tys
1061 tcTyVarsOfType (PredTy sty) = tcTyVarsOfPred sty
1062 tcTyVarsOfType (FunTy arg res) = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
1063 tcTyVarsOfType (AppTy fun arg) = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
1064 tcTyVarsOfType (ForAllTy tyvar ty) = (tcTyVarsOfType ty `delVarSet` tyvar)
1065 `unionVarSet` tcTyVarsOfTyVar tyvar
1066 -- We do sometimes quantify over skolem TcTyVars
1068 tcTyVarsOfTyVar :: TcTyVar -> TyVarSet
1069 tcTyVarsOfTyVar tv | isCoVar tv = tcTyVarsOfType (tyVarKind tv)
1070 | otherwise = emptyVarSet
1072 tcTyVarsOfTypes :: [Type] -> TyVarSet
1073 tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
1075 tcTyVarsOfPred :: PredType -> TyVarSet
1076 tcTyVarsOfPred (IParam _ ty) = tcTyVarsOfType ty
1077 tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
1078 tcTyVarsOfPred (EqPred ty1 ty2) = tcTyVarsOfType ty1 `unionVarSet` tcTyVarsOfType ty2
1081 Note [Silly type synonym]
1082 ~~~~~~~~~~~~~~~~~~~~~~~~~
1085 What are the free tyvars of (T x)? Empty, of course!
1086 Here's the example that Ralf Laemmel showed me:
1087 foo :: (forall a. C u a -> C u a) -> u
1088 mappend :: Monoid u => u -> u -> u
1090 bar :: Monoid u => u
1091 bar = foo (\t -> t `mappend` t)
1092 We have to generalise at the arg to f, and we don't
1093 want to capture the constraint (Monad (C u a)) because
1094 it appears to mention a. Pretty silly, but it was useful to him.
1096 exactTyVarsOfType is used by the type checker to figure out exactly
1097 which type variables are mentioned in a type. It's also used in the
1098 smart-app checking code --- see TcExpr.tcIdApp
1100 On the other hand, consider a *top-level* definition
1101 f = (\x -> x) :: T a -> T a
1102 If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
1103 if we have an application like (f "x") we get a confusing error message
1104 involving Any. So the conclusion is this: when generalising
1105 - at top level use tyVarsOfType
1106 - in nested bindings use exactTyVarsOfType
1107 See Trac #1813 for example.
1110 exactTyVarsOfType :: TcType -> TyVarSet
1111 -- Find the free type variables (of any kind)
1112 -- but *expand* type synonyms. See Note [Silly type synonym] above.
1113 exactTyVarsOfType ty
1116 go ty | Just ty' <- tcView ty = go ty' -- This is the key line
1117 go (TyVarTy tv) = unitVarSet tv
1118 go (TyConApp _ tys) = exactTyVarsOfTypes tys
1119 go (PredTy ty) = go_pred ty
1120 go (FunTy arg res) = go arg `unionVarSet` go res
1121 go (AppTy fun arg) = go fun `unionVarSet` go arg
1122 go (ForAllTy tyvar ty) = delVarSet (go ty) tyvar
1123 `unionVarSet` go_tv tyvar
1125 go_pred (IParam _ ty) = go ty
1126 go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
1127 go_pred (EqPred ty1 ty2) = go ty1 `unionVarSet` go ty2
1129 go_tv tyvar | isCoVar tyvar = go (tyVarKind tyvar)
1130 | otherwise = emptyVarSet
1132 exactTyVarsOfTypes :: [TcType] -> TyVarSet
1133 exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
1136 Find the free tycons and classes of a type. This is used in the front
1137 end of the compiler.
1140 tyClsNamesOfType :: Type -> NameSet
1141 tyClsNamesOfType (TyVarTy _) = emptyNameSet
1142 tyClsNamesOfType (TyConApp tycon tys) = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
1143 tyClsNamesOfType (PredTy (IParam _ ty)) = tyClsNamesOfType ty
1144 tyClsNamesOfType (PredTy (ClassP cl tys)) = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
1145 tyClsNamesOfType (PredTy (EqPred ty1 ty2)) = tyClsNamesOfType ty1 `unionNameSets` tyClsNamesOfType ty2
1146 tyClsNamesOfType (FunTy arg res) = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
1147 tyClsNamesOfType (AppTy fun arg) = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
1148 tyClsNamesOfType (ForAllTy _ ty) = tyClsNamesOfType ty
1150 tyClsNamesOfTypes :: [Type] -> NameSet
1151 tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
1153 tyClsNamesOfDFunHead :: Type -> NameSet
1154 -- Find the free type constructors and classes
1155 -- of the head of the dfun instance type
1156 -- The 'dfun_head_type' is because of
1157 -- instance Foo a => Baz T where ...
1158 -- The decl is an orphan if Baz and T are both not locally defined,
1159 -- even if Foo *is* locally defined
1160 tyClsNamesOfDFunHead dfun_ty
1161 = case tcSplitSigmaTy dfun_ty of
1162 (_, _, head_ty) -> tyClsNamesOfType head_ty
1166 %************************************************************************
1168 \subsection[TysWiredIn-ext-type]{External types}
1170 %************************************************************************
1172 The compiler's foreign function interface supports the passing of a
1173 restricted set of types as arguments and results (the restricting factor
1177 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, CoercionI)
1178 -- (isIOType t) returns Just (IO,t',co)
1179 -- if co : t ~ IO t'
1180 -- returns Nothing otherwise
1181 tcSplitIOType_maybe ty
1182 = case tcSplitTyConApp_maybe ty of
1183 -- This split absolutely has to be a tcSplit, because we must
1184 -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
1186 Just (io_tycon, [io_res_ty])
1187 | io_tycon `hasKey` ioTyConKey
1188 -> Just (io_tycon, io_res_ty, IdCo)
1191 | not (isRecursiveTyCon tc)
1192 , Just (ty, co1) <- instNewTyCon_maybe tc tys
1193 -- Newtypes that require a coercion are ok
1194 -> case tcSplitIOType_maybe ty of
1196 Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCoI` co2)
1200 isFFITy :: Type -> Bool
1201 -- True for any TyCon that can possibly be an arg or result of an FFI call
1202 isFFITy ty = checkRepTyCon legalFFITyCon ty
1204 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1205 -- Checks for valid argument type for a 'foreign import'
1206 isFFIArgumentTy dflags safety ty
1207 = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1209 isFFIExternalTy :: Type -> Bool
1210 -- Types that are allowed as arguments of a 'foreign export'
1211 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1213 isFFIImportResultTy :: DynFlags -> Type -> Bool
1214 isFFIImportResultTy dflags ty
1215 = checkRepTyCon (legalFIResultTyCon dflags) ty
1217 isFFIExportResultTy :: Type -> Bool
1218 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1220 isFFIDynArgumentTy :: Type -> Bool
1221 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
1222 -- or a newtype of either.
1223 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1225 isFFIDynResultTy :: Type -> Bool
1226 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
1227 -- or a newtype of either.
1228 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1230 isFFILabelTy :: Type -> Bool
1231 -- The type of a foreign label must be Ptr, FunPtr, Addr,
1232 -- or a newtype of either.
1233 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1235 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1236 -- Checks for valid argument type for a 'foreign import prim'
1237 -- Currently they must all be simple unlifted types.
1238 isFFIPrimArgumentTy dflags ty
1239 = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1241 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1242 -- Checks for valid result type for a 'foreign import prim'
1243 -- Currently it must be an unlifted type, including unboxed tuples.
1244 isFFIPrimResultTy dflags ty
1245 = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1247 isFFIDotnetTy :: DynFlags -> Type -> Bool
1248 isFFIDotnetTy dflags ty
1249 = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
1250 isFFIDotnetObjTy ty || isStringTy ty)) ty
1251 -- NB: isStringTy used to look through newtypes, but
1252 -- it no longer does so. May need to adjust isFFIDotNetTy
1253 -- if we do want to look through newtypes.
1255 isFFIDotnetObjTy :: Type -> Bool
1257 = checkRepTyCon check_tc t_ty
1259 (_, t_ty) = tcSplitForAllTys ty
1260 check_tc tc = getName tc == objectTyConName
1262 isFunPtrTy :: Type -> Bool
1263 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1265 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1266 -- Look through newtypes, but *not* foralls
1267 -- Should work even for recursive newtypes
1268 -- eg Manuel had: newtype T = MkT (Ptr T)
1269 checkRepTyCon check_tc ty
1273 | Just (tc,tys) <- splitTyConApp_maybe ty
1274 = case carefullySplitNewType_maybe rec_nts tc tys of
1275 Just (rec_nts', ty') -> go rec_nts' ty'
1276 Nothing -> check_tc tc
1280 checkRepTyConKey :: [Unique] -> Type -> Bool
1281 -- Like checkRepTyCon, but just looks at the TyCon key
1282 checkRepTyConKey keys
1283 = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1286 ----------------------------------------------
1287 These chaps do the work; they are not exported
1288 ----------------------------------------------
1291 legalFEArgTyCon :: TyCon -> Bool
1293 -- It's illegal to make foreign exports that take unboxed
1294 -- arguments. The RTS API currently can't invoke such things. --SDM 7/2000
1295 = boxedMarshalableTyCon tc
1297 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1298 legalFIResultTyCon dflags tc
1299 | tc == unitTyCon = True
1300 | otherwise = marshalableTyCon dflags tc
1302 legalFEResultTyCon :: TyCon -> Bool
1303 legalFEResultTyCon tc
1304 | tc == unitTyCon = True
1305 | otherwise = boxedMarshalableTyCon tc
1307 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1308 -- Checks validity of types going from Haskell -> external world
1309 legalOutgoingTyCon dflags _ tc
1310 = marshalableTyCon dflags tc
1312 legalFFITyCon :: TyCon -> Bool
1313 -- True for any TyCon that can possibly be an arg or result of an FFI call
1315 = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1317 marshalableTyCon :: DynFlags -> TyCon -> Bool
1318 marshalableTyCon dflags tc
1319 = (dopt Opt_UnliftedFFITypes dflags
1320 && isUnLiftedTyCon tc
1321 && not (isUnboxedTupleTyCon tc)
1322 && case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1325 || boxedMarshalableTyCon tc
1327 boxedMarshalableTyCon :: TyCon -> Bool
1328 boxedMarshalableTyCon tc
1329 = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1330 , int32TyConKey, int64TyConKey
1331 , wordTyConKey, word8TyConKey, word16TyConKey
1332 , word32TyConKey, word64TyConKey
1333 , floatTyConKey, doubleTyConKey
1334 , ptrTyConKey, funPtrTyConKey
1340 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1341 -- Check args of 'foreign import prim', only allow simple unlifted types.
1342 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1343 -- currently they're of the wrong kind to use in function args anyway.
1344 legalFIPrimArgTyCon dflags tc
1345 = dopt Opt_UnliftedFFITypes dflags
1346 && isUnLiftedTyCon tc
1347 && not (isUnboxedTupleTyCon tc)
1349 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1350 -- Check result type of 'foreign import prim'. Allow simple unlifted
1351 -- types and also unboxed tuple result types '... -> (# , , #)'
1352 legalFIPrimResultTyCon dflags tc
1353 = dopt Opt_UnliftedFFITypes dflags
1354 && isUnLiftedTyCon tc
1355 && (isUnboxedTupleTyCon tc
1356 || case tyConPrimRep tc of -- Note [Marshalling VoidRep]
1361 Note [Marshalling VoidRep]
1362 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1363 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1364 In turn that means you can't write
1365 foreign import foo :: Int -> State# RealWorld
1367 Reason: the back end falls over with panic "primRepHint:VoidRep";
1368 and there is no compelling reason to permit it